├── .Rbuildignore ├── .gitattributes ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE.md ├── NAMESPACE ├── R ├── install.R ├── install_binary.R ├── install_binary_process.R ├── pkginstall.R ├── progress-bar.R ├── tar.R ├── utils.R ├── verify_binary.R └── zip.R ├── README.md ├── appveyor.yml ├── codecov.yml ├── inst └── tools │ ├── pkg_1.0.0.tgz │ ├── xxx │ ├── xxx.bz2 │ ├── xxx.gz │ ├── xxx.tar.gz │ ├── xxx.xz │ └── xxx.zip ├── man ├── install_binary.Rd ├── install_package_plan.Rd ├── make_untar_process.Rd ├── need_internal_tar.Rd └── pkginstall-package.Rd ├── pkginstall.Rproj └── tests ├── testthat.R └── testthat ├── fixtures ├── packages │ ├── bad1 │ │ ├── file1 │ │ └── file2 │ ├── bad2 │ │ └── bad2 │ │ │ ├── DESCRIPTION │ │ │ └── Meta │ │ │ └── package.rds │ ├── bad3 │ │ └── bad3 │ │ │ ├── DESCRIPTION │ │ │ └── Meta │ │ │ └── package.rds │ └── bad4 │ │ └── bad4 │ │ ├── DESCRIPTION │ │ └── Meta │ │ └── package.rds └── sample_plan.rds ├── foo ├── DESCRIPTION ├── NAMESPACE ├── R │ └── foo.R └── src │ └── init.c ├── helper.R ├── test-install-binary.R ├── test-install-parts.R ├── test-install.R ├── test-metadata.R ├── test-paths.R ├── test-tar.R ├── test-utils.R ├── test-verify-extracted-package.R └── test-zip.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^\.travis\.yml$ 5 | ^codecov\.yml$ 6 | ^appveyor\.yml$ 7 | ^tests/testthat/foo/src/.*o$ 8 | ^script\.R$ 9 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | pkginstall.Rproj text 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *.tgz 5 | script.R 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: false 5 | cache: packages 6 | 7 | r: 8 | - 3.2 9 | - 3.3 10 | - 3.4 11 | - 3.5 12 | - release 13 | - devel 14 | 15 | matrix: 16 | include: 17 | - os: osx 18 | r: release 19 | 20 | after_success: 21 | - test $TRAVIS_R_VERSION_STRING = "release" && Rscript -e 'covr::codecov()' 22 | 23 | env: 24 | global: 25 | - NOT_CRAN="true" 26 | - _R_CHECK_SYSTEM_CLOCK_="FALSE" 27 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: pkginstall 2 | Title: Installs Packages from Local Files 3 | Version: 0.0.0.9001 4 | Authors@R: 5 | c(person("Jim", "Hester", email = "james.f.hester@gmail.com", 6 | role = c("aut", "cre")), 7 | person("Gábor", "Gábor", email = "csardi.gabor@gmail.com", role = "aut")) 8 | Description: Provides a replacement for `utils::install.packages(repo = NULL)`. 9 | I.e. it builds binary packages from source packages, and extracts the 10 | compressed archives into the package library. 11 | License: GPL-3 12 | Depends: 13 | R (>= 3.1) 14 | Imports: 15 | callr (>= 3.1.0), 16 | cli (>= 1.0.1), 17 | cliapp (>= 0.1.0), 18 | crayon, 19 | desc (>= 1.2.0), 20 | filelock (>= 1.0.2), 21 | glue (>= 1.3.0), 22 | pkgbuild, 23 | prettyunits, 24 | R6, 25 | rlang (>= 0.2.0), 26 | withr (>= 2.1.1), 27 | zip (>= 2.0.2) 28 | Suggests: 29 | covr, 30 | mockery, 31 | rstudioapi, 32 | testthat 33 | ByteCompile: true 34 | Encoding: UTF-8 35 | LazyData: true 36 | RoxygenNote: 6.1.1 37 | Roxygen: list(markdown = TRUE) 38 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | GNU General Public License 2 | ========================== 3 | 4 | _Version 3, 29 June 2007_ 5 | _Copyright © 2007 Free Software Foundation, Inc. <>_ 6 | 7 | Everyone is permitted to copy and distribute verbatim copies of this license 8 | document, but changing it is not allowed. 9 | 10 | ## Preamble 11 | 12 | The GNU General Public License is a free, copyleft license for software and other 13 | kinds of works. 14 | 15 | The licenses for most software and other practical works are designed to take away 16 | your freedom to share and change the works. By contrast, the GNU General Public 17 | License is intended to guarantee your freedom to share and change all versions of a 18 | program--to make sure it remains free software for all its users. We, the Free 19 | Software Foundation, use the GNU General Public License for most of our software; it 20 | applies also to any other work released this way by its authors. You can apply it to 21 | your programs, too. 22 | 23 | When we speak of free software, we are referring to freedom, not price. Our General 24 | Public Licenses are designed to make sure that you have the freedom to distribute 25 | copies of free software (and charge for them if you wish), that you receive source 26 | code or can get it if you want it, that you can change the software or use pieces of 27 | it in new free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you these rights or 30 | asking you to surrender the rights. Therefore, you have certain responsibilities if 31 | you distribute copies of the software, or if you modify it: responsibilities to 32 | respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether gratis or for a fee, 35 | you must pass on to the recipients the same freedoms that you received. You must make 36 | sure that they, too, receive or can get the source code. And you must show them these 37 | terms so they know their rights. 38 | 39 | Developers that use the GNU GPL protect your rights with two steps: **(1)** assert 40 | copyright on the software, and **(2)** offer you this License giving you legal permission 41 | to copy, distribute and/or modify it. 42 | 43 | For the developers' and authors' protection, the GPL clearly explains that there is 44 | no warranty for this free software. For both users' and authors' sake, the GPL 45 | requires that modified versions be marked as changed, so that their problems will not 46 | be attributed erroneously to authors of previous versions. 47 | 48 | Some devices are designed to deny users access to install or run modified versions of 49 | the software inside them, although the manufacturer can do so. This is fundamentally 50 | incompatible with the aim of protecting users' freedom to change the software. The 51 | systematic pattern of such abuse occurs in the area of products for individuals to 52 | use, which is precisely where it is most unacceptable. Therefore, we have designed 53 | this version of the GPL to prohibit the practice for those products. If such problems 54 | arise substantially in other domains, we stand ready to extend this provision to 55 | those domains in future versions of the GPL, as needed to protect the freedom of 56 | users. 57 | 58 | Finally, every program is threatened constantly by software patents. States should 59 | not allow patents to restrict development and use of software on general-purpose 60 | computers, but in those that do, we wish to avoid the special danger that patents 61 | applied to a free program could make it effectively proprietary. To prevent this, the 62 | GPL assures that patents cannot be used to render the program non-free. 63 | 64 | The precise terms and conditions for copying, distribution and modification follow. 65 | 66 | ## TERMS AND CONDITIONS 67 | 68 | ### 0. Definitions 69 | 70 | “This License” refers to version 3 of the GNU General Public License. 71 | 72 | “Copyright” also means copyright-like laws that apply to other kinds of 73 | works, such as semiconductor masks. 74 | 75 | “The Program” refers to any copyrightable work licensed under this 76 | License. Each licensee is addressed as “you”. “Licensees” and 77 | “recipients” may be individuals or organizations. 78 | 79 | To “modify” a work means to copy from or adapt all or part of the work in 80 | a fashion requiring copyright permission, other than the making of an exact copy. The 81 | resulting work is called a “modified version” of the earlier work or a 82 | work “based on” the earlier work. 83 | 84 | A “covered work” means either the unmodified Program or a work based on 85 | the Program. 86 | 87 | To “propagate” a work means to do anything with it that, without 88 | permission, would make you directly or secondarily liable for infringement under 89 | applicable copyright law, except executing it on a computer or modifying a private 90 | copy. Propagation includes copying, distribution (with or without modification), 91 | making available to the public, and in some countries other activities as well. 92 | 93 | To “convey” a work means any kind of propagation that enables other 94 | parties to make or receive copies. Mere interaction with a user through a computer 95 | network, with no transfer of a copy, is not conveying. 96 | 97 | An interactive user interface displays “Appropriate Legal Notices” to the 98 | extent that it includes a convenient and prominently visible feature that **(1)** 99 | displays an appropriate copyright notice, and **(2)** tells the user that there is no 100 | warranty for the work (except to the extent that warranties are provided), that 101 | licensees may convey the work under this License, and how to view a copy of this 102 | License. If the interface presents a list of user commands or options, such as a 103 | menu, a prominent item in the list meets this criterion. 104 | 105 | ### 1. Source Code 106 | 107 | The “source code” for a work means the preferred form of the work for 108 | making modifications to it. “Object code” means any non-source form of a 109 | work. 110 | 111 | A “Standard Interface” means an interface that either is an official 112 | standard defined by a recognized standards body, or, in the case of interfaces 113 | specified for a particular programming language, one that is widely used among 114 | developers working in that language. 115 | 116 | The “System Libraries” of an executable work include anything, other than 117 | the work as a whole, that **(a)** is included in the normal form of packaging a Major 118 | Component, but which is not part of that Major Component, and **(b)** serves only to 119 | enable use of the work with that Major Component, or to implement a Standard 120 | Interface for which an implementation is available to the public in source code form. 121 | A “Major Component”, in this context, means a major essential component 122 | (kernel, window system, and so on) of the specific operating system (if any) on which 123 | the executable work runs, or a compiler used to produce the work, or an object code 124 | interpreter used to run it. 125 | 126 | The “Corresponding Source” for a work in object code form means all the 127 | source code needed to generate, install, and (for an executable work) run the object 128 | code and to modify the work, including scripts to control those activities. However, 129 | it does not include the work's System Libraries, or general-purpose tools or 130 | generally available free programs which are used unmodified in performing those 131 | activities but which are not part of the work. For example, Corresponding Source 132 | includes interface definition files associated with source files for the work, and 133 | the source code for shared libraries and dynamically linked subprograms that the work 134 | is specifically designed to require, such as by intimate data communication or 135 | control flow between those subprograms and other parts of the work. 136 | 137 | The Corresponding Source need not include anything that users can regenerate 138 | automatically from other parts of the Corresponding Source. 139 | 140 | The Corresponding Source for a work in source code form is that same work. 141 | 142 | ### 2. Basic Permissions 143 | 144 | All rights granted under this License are granted for the term of copyright on the 145 | Program, and are irrevocable provided the stated conditions are met. This License 146 | explicitly affirms your unlimited permission to run the unmodified Program. The 147 | output from running a covered work is covered by this License only if the output, 148 | given its content, constitutes a covered work. This License acknowledges your rights 149 | of fair use or other equivalent, as provided by copyright law. 150 | 151 | You may make, run and propagate covered works that you do not convey, without 152 | conditions so long as your license otherwise remains in force. You may convey covered 153 | works to others for the sole purpose of having them make modifications exclusively 154 | for you, or provide you with facilities for running those works, provided that you 155 | comply with the terms of this License in conveying all material for which you do not 156 | control copyright. Those thus making or running the covered works for you must do so 157 | exclusively on your behalf, under your direction and control, on terms that prohibit 158 | them from making any copies of your copyrighted material outside their relationship 159 | with you. 160 | 161 | Conveying under any other circumstances is permitted solely under the conditions 162 | stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 163 | 164 | ### 3. Protecting Users' Legal Rights From Anti-Circumvention Law 165 | 166 | No covered work shall be deemed part of an effective technological measure under any 167 | applicable law fulfilling obligations under article 11 of the WIPO copyright treaty 168 | adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention 169 | of such measures. 170 | 171 | When you convey a covered work, you waive any legal power to forbid circumvention of 172 | technological measures to the extent such circumvention is effected by exercising 173 | rights under this License with respect to the covered work, and you disclaim any 174 | intention to limit operation or modification of the work as a means of enforcing, 175 | against the work's users, your or third parties' legal rights to forbid circumvention 176 | of technological measures. 177 | 178 | ### 4. Conveying Verbatim Copies 179 | 180 | You may convey verbatim copies of the Program's source code as you receive it, in any 181 | medium, provided that you conspicuously and appropriately publish on each copy an 182 | appropriate copyright notice; keep intact all notices stating that this License and 183 | any non-permissive terms added in accord with section 7 apply to the code; keep 184 | intact all notices of the absence of any warranty; and give all recipients a copy of 185 | this License along with the Program. 186 | 187 | You may charge any price or no price for each copy that you convey, and you may offer 188 | support or warranty protection for a fee. 189 | 190 | ### 5. Conveying Modified Source Versions 191 | 192 | You may convey a work based on the Program, or the modifications to produce it from 193 | the Program, in the form of source code under the terms of section 4, provided that 194 | you also meet all of these conditions: 195 | 196 | * **a)** The work must carry prominent notices stating that you modified it, and giving a 197 | relevant date. 198 | * **b)** The work must carry prominent notices stating that it is released under this 199 | License and any conditions added under section 7. This requirement modifies the 200 | requirement in section 4 to “keep intact all notices”. 201 | * **c)** You must license the entire work, as a whole, under this License to anyone who 202 | comes into possession of a copy. This License will therefore apply, along with any 203 | applicable section 7 additional terms, to the whole of the work, and all its parts, 204 | regardless of how they are packaged. This License gives no permission to license the 205 | work in any other way, but it does not invalidate such permission if you have 206 | separately received it. 207 | * **d)** If the work has interactive user interfaces, each must display Appropriate Legal 208 | Notices; however, if the Program has interactive interfaces that do not display 209 | Appropriate Legal Notices, your work need not make them do so. 210 | 211 | A compilation of a covered work with other separate and independent works, which are 212 | not by their nature extensions of the covered work, and which are not combined with 213 | it such as to form a larger program, in or on a volume of a storage or distribution 214 | medium, is called an “aggregate” if the compilation and its resulting 215 | copyright are not used to limit the access or legal rights of the compilation's users 216 | beyond what the individual works permit. Inclusion of a covered work in an aggregate 217 | does not cause this License to apply to the other parts of the aggregate. 218 | 219 | ### 6. Conveying Non-Source Forms 220 | 221 | You may convey a covered work in object code form under the terms of sections 4 and 222 | 5, provided that you also convey the machine-readable Corresponding Source under the 223 | terms of this License, in one of these ways: 224 | 225 | * **a)** Convey the object code in, or embodied in, a physical product (including a 226 | physical distribution medium), accompanied by the Corresponding Source fixed on a 227 | durable physical medium customarily used for software interchange. 228 | * **b)** Convey the object code in, or embodied in, a physical product (including a 229 | physical distribution medium), accompanied by a written offer, valid for at least 230 | three years and valid for as long as you offer spare parts or customer support for 231 | that product model, to give anyone who possesses the object code either **(1)** a copy of 232 | the Corresponding Source for all the software in the product that is covered by this 233 | License, on a durable physical medium customarily used for software interchange, for 234 | a price no more than your reasonable cost of physically performing this conveying of 235 | source, or **(2)** access to copy the Corresponding Source from a network server at no 236 | charge. 237 | * **c)** Convey individual copies of the object code with a copy of the written offer to 238 | provide the Corresponding Source. This alternative is allowed only occasionally and 239 | noncommercially, and only if you received the object code with such an offer, in 240 | accord with subsection 6b. 241 | * **d)** Convey the object code by offering access from a designated place (gratis or for 242 | a charge), and offer equivalent access to the Corresponding Source in the same way 243 | through the same place at no further charge. You need not require recipients to copy 244 | the Corresponding Source along with the object code. If the place to copy the object 245 | code is a network server, the Corresponding Source may be on a different server 246 | (operated by you or a third party) that supports equivalent copying facilities, 247 | provided you maintain clear directions next to the object code saying where to find 248 | the Corresponding Source. Regardless of what server hosts the Corresponding Source, 249 | you remain obligated to ensure that it is available for as long as needed to satisfy 250 | these requirements. 251 | * **e)** Convey the object code using peer-to-peer transmission, provided you inform 252 | other peers where the object code and Corresponding Source of the work are being 253 | offered to the general public at no charge under subsection 6d. 254 | 255 | A separable portion of the object code, whose source code is excluded from the 256 | Corresponding Source as a System Library, need not be included in conveying the 257 | object code work. 258 | 259 | A “User Product” is either **(1)** a “consumer product”, which 260 | means any tangible personal property which is normally used for personal, family, or 261 | household purposes, or **(2)** anything designed or sold for incorporation into a 262 | dwelling. In determining whether a product is a consumer product, doubtful cases 263 | shall be resolved in favor of coverage. For a particular product received by a 264 | particular user, “normally used” refers to a typical or common use of 265 | that class of product, regardless of the status of the particular user or of the way 266 | in which the particular user actually uses, or expects or is expected to use, the 267 | product. A product is a consumer product regardless of whether the product has 268 | substantial commercial, industrial or non-consumer uses, unless such uses represent 269 | the only significant mode of use of the product. 270 | 271 | “Installation Information” for a User Product means any methods, 272 | procedures, authorization keys, or other information required to install and execute 273 | modified versions of a covered work in that User Product from a modified version of 274 | its Corresponding Source. The information must suffice to ensure that the continued 275 | functioning of the modified object code is in no case prevented or interfered with 276 | solely because modification has been made. 277 | 278 | If you convey an object code work under this section in, or with, or specifically for 279 | use in, a User Product, and the conveying occurs as part of a transaction in which 280 | the right of possession and use of the User Product is transferred to the recipient 281 | in perpetuity or for a fixed term (regardless of how the transaction is 282 | characterized), the Corresponding Source conveyed under this section must be 283 | accompanied by the Installation Information. But this requirement does not apply if 284 | neither you nor any third party retains the ability to install modified object code 285 | on the User Product (for example, the work has been installed in ROM). 286 | 287 | The requirement to provide Installation Information does not include a requirement to 288 | continue to provide support service, warranty, or updates for a work that has been 289 | modified or installed by the recipient, or for the User Product in which it has been 290 | modified or installed. Access to a network may be denied when the modification itself 291 | materially and adversely affects the operation of the network or violates the rules 292 | and protocols for communication across the network. 293 | 294 | Corresponding Source conveyed, and Installation Information provided, in accord with 295 | this section must be in a format that is publicly documented (and with an 296 | implementation available to the public in source code form), and must require no 297 | special password or key for unpacking, reading or copying. 298 | 299 | ### 7. Additional Terms 300 | 301 | “Additional permissions” are terms that supplement the terms of this 302 | License by making exceptions from one or more of its conditions. Additional 303 | permissions that are applicable to the entire Program shall be treated as though they 304 | were included in this License, to the extent that they are valid under applicable 305 | law. If additional permissions apply only to part of the Program, that part may be 306 | used separately under those permissions, but the entire Program remains governed by 307 | this License without regard to the additional permissions. 308 | 309 | When you convey a copy of a covered work, you may at your option remove any 310 | additional permissions from that copy, or from any part of it. (Additional 311 | permissions may be written to require their own removal in certain cases when you 312 | modify the work.) You may place additional permissions on material, added by you to a 313 | covered work, for which you have or can give appropriate copyright permission. 314 | 315 | Notwithstanding any other provision of this License, for material you add to a 316 | covered work, you may (if authorized by the copyright holders of that material) 317 | supplement the terms of this License with terms: 318 | 319 | * **a)** Disclaiming warranty or limiting liability differently from the terms of 320 | sections 15 and 16 of this License; or 321 | * **b)** Requiring preservation of specified reasonable legal notices or author 322 | attributions in that material or in the Appropriate Legal Notices displayed by works 323 | containing it; or 324 | * **c)** Prohibiting misrepresentation of the origin of that material, or requiring that 325 | modified versions of such material be marked in reasonable ways as different from the 326 | original version; or 327 | * **d)** Limiting the use for publicity purposes of names of licensors or authors of the 328 | material; or 329 | * **e)** Declining to grant rights under trademark law for use of some trade names, 330 | trademarks, or service marks; or 331 | * **f)** Requiring indemnification of licensors and authors of that material by anyone 332 | who conveys the material (or modified versions of it) with contractual assumptions of 333 | liability to the recipient, for any liability that these contractual assumptions 334 | directly impose on those licensors and authors. 335 | 336 | All other non-permissive additional terms are considered “further 337 | restrictions” within the meaning of section 10. If the Program as you received 338 | it, or any part of it, contains a notice stating that it is governed by this License 339 | along with a term that is a further restriction, you may remove that term. If a 340 | license document contains a further restriction but permits relicensing or conveying 341 | under this License, you may add to a covered work material governed by the terms of 342 | that license document, provided that the further restriction does not survive such 343 | relicensing or conveying. 344 | 345 | If you add terms to a covered work in accord with this section, you must place, in 346 | the relevant source files, a statement of the additional terms that apply to those 347 | files, or a notice indicating where to find the applicable terms. 348 | 349 | Additional terms, permissive or non-permissive, may be stated in the form of a 350 | separately written license, or stated as exceptions; the above requirements apply 351 | either way. 352 | 353 | ### 8. Termination 354 | 355 | You may not propagate or modify a covered work except as expressly provided under 356 | this License. Any attempt otherwise to propagate or modify it is void, and will 357 | automatically terminate your rights under this License (including any patent licenses 358 | granted under the third paragraph of section 11). 359 | 360 | However, if you cease all violation of this License, then your license from a 361 | particular copyright holder is reinstated **(a)** provisionally, unless and until the 362 | copyright holder explicitly and finally terminates your license, and **(b)** permanently, 363 | if the copyright holder fails to notify you of the violation by some reasonable means 364 | prior to 60 days after the cessation. 365 | 366 | Moreover, your license from a particular copyright holder is reinstated permanently 367 | if the copyright holder notifies you of the violation by some reasonable means, this 368 | is the first time you have received notice of violation of this License (for any 369 | work) from that copyright holder, and you cure the violation prior to 30 days after 370 | your receipt of the notice. 371 | 372 | Termination of your rights under this section does not terminate the licenses of 373 | parties who have received copies or rights from you under this License. If your 374 | rights have been terminated and not permanently reinstated, you do not qualify to 375 | receive new licenses for the same material under section 10. 376 | 377 | ### 9. Acceptance Not Required for Having Copies 378 | 379 | You are not required to accept this License in order to receive or run a copy of the 380 | Program. Ancillary propagation of a covered work occurring solely as a consequence of 381 | using peer-to-peer transmission to receive a copy likewise does not require 382 | acceptance. However, nothing other than this License grants you permission to 383 | propagate or modify any covered work. These actions infringe copyright if you do not 384 | accept this License. Therefore, by modifying or propagating a covered work, you 385 | indicate your acceptance of this License to do so. 386 | 387 | ### 10. Automatic Licensing of Downstream Recipients 388 | 389 | Each time you convey a covered work, the recipient automatically receives a license 390 | from the original licensors, to run, modify and propagate that work, subject to this 391 | License. You are not responsible for enforcing compliance by third parties with this 392 | License. 393 | 394 | An “entity transaction” is a transaction transferring control of an 395 | organization, or substantially all assets of one, or subdividing an organization, or 396 | merging organizations. If propagation of a covered work results from an entity 397 | transaction, each party to that transaction who receives a copy of the work also 398 | receives whatever licenses to the work the party's predecessor in interest had or 399 | could give under the previous paragraph, plus a right to possession of the 400 | Corresponding Source of the work from the predecessor in interest, if the predecessor 401 | has it or can get it with reasonable efforts. 402 | 403 | You may not impose any further restrictions on the exercise of the rights granted or 404 | affirmed under this License. For example, you may not impose a license fee, royalty, 405 | or other charge for exercise of rights granted under this License, and you may not 406 | initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging 407 | that any patent claim is infringed by making, using, selling, offering for sale, or 408 | importing the Program or any portion of it. 409 | 410 | ### 11. Patents 411 | 412 | A “contributor” is a copyright holder who authorizes use under this 413 | License of the Program or a work on which the Program is based. The work thus 414 | licensed is called the contributor's “contributor version”. 415 | 416 | A contributor's “essential patent claims” are all patent claims owned or 417 | controlled by the contributor, whether already acquired or hereafter acquired, that 418 | would be infringed by some manner, permitted by this License, of making, using, or 419 | selling its contributor version, but do not include claims that would be infringed 420 | only as a consequence of further modification of the contributor version. For 421 | purposes of this definition, “control” includes the right to grant patent 422 | sublicenses in a manner consistent with the requirements of this License. 423 | 424 | Each contributor grants you a non-exclusive, worldwide, royalty-free patent license 425 | under the contributor's essential patent claims, to make, use, sell, offer for sale, 426 | import and otherwise run, modify and propagate the contents of its contributor 427 | version. 428 | 429 | In the following three paragraphs, a “patent license” is any express 430 | agreement or commitment, however denominated, not to enforce a patent (such as an 431 | express permission to practice a patent or covenant not to sue for patent 432 | infringement). To “grant” such a patent license to a party means to make 433 | such an agreement or commitment not to enforce a patent against the party. 434 | 435 | If you convey a covered work, knowingly relying on a patent license, and the 436 | Corresponding Source of the work is not available for anyone to copy, free of charge 437 | and under the terms of this License, through a publicly available network server or 438 | other readily accessible means, then you must either **(1)** cause the Corresponding 439 | Source to be so available, or **(2)** arrange to deprive yourself of the benefit of the 440 | patent license for this particular work, or **(3)** arrange, in a manner consistent with 441 | the requirements of this License, to extend the patent license to downstream 442 | recipients. “Knowingly relying” means you have actual knowledge that, but 443 | for the patent license, your conveying the covered work in a country, or your 444 | recipient's use of the covered work in a country, would infringe one or more 445 | identifiable patents in that country that you have reason to believe are valid. 446 | 447 | If, pursuant to or in connection with a single transaction or arrangement, you 448 | convey, or propagate by procuring conveyance of, a covered work, and grant a patent 449 | license to some of the parties receiving the covered work authorizing them to use, 450 | propagate, modify or convey a specific copy of the covered work, then the patent 451 | license you grant is automatically extended to all recipients of the covered work and 452 | works based on it. 453 | 454 | A patent license is “discriminatory” if it does not include within the 455 | scope of its coverage, prohibits the exercise of, or is conditioned on the 456 | non-exercise of one or more of the rights that are specifically granted under this 457 | License. You may not convey a covered work if you are a party to an arrangement with 458 | a third party that is in the business of distributing software, under which you make 459 | payment to the third party based on the extent of your activity of conveying the 460 | work, and under which the third party grants, to any of the parties who would receive 461 | the covered work from you, a discriminatory patent license **(a)** in connection with 462 | copies of the covered work conveyed by you (or copies made from those copies), or **(b)** 463 | primarily for and in connection with specific products or compilations that contain 464 | the covered work, unless you entered into that arrangement, or that patent license 465 | was granted, prior to 28 March 2007. 466 | 467 | Nothing in this License shall be construed as excluding or limiting any implied 468 | license or other defenses to infringement that may otherwise be available to you 469 | under applicable patent law. 470 | 471 | ### 12. No Surrender of Others' Freedom 472 | 473 | If conditions are imposed on you (whether by court order, agreement or otherwise) 474 | that contradict the conditions of this License, they do not excuse you from the 475 | conditions of this License. If you cannot convey a covered work so as to satisfy 476 | simultaneously your obligations under this License and any other pertinent 477 | obligations, then as a consequence you may not convey it at all. For example, if you 478 | agree to terms that obligate you to collect a royalty for further conveying from 479 | those to whom you convey the Program, the only way you could satisfy both those terms 480 | and this License would be to refrain entirely from conveying the Program. 481 | 482 | ### 13. Use with the GNU Affero General Public License 483 | 484 | Notwithstanding any other provision of this License, you have permission to link or 485 | combine any covered work with a work licensed under version 3 of the GNU Affero 486 | General Public License into a single combined work, and to convey the resulting work. 487 | The terms of this License will continue to apply to the part which is the covered 488 | work, but the special requirements of the GNU Affero General Public License, section 489 | 13, concerning interaction through a network will apply to the combination as such. 490 | 491 | ### 14. Revised Versions of this License 492 | 493 | The Free Software Foundation may publish revised and/or new versions of the GNU 494 | General Public License from time to time. Such new versions will be similar in spirit 495 | to the present version, but may differ in detail to address new problems or concerns. 496 | 497 | Each version is given a distinguishing version number. If the Program specifies that 498 | a certain numbered version of the GNU General Public License “or any later 499 | version” applies to it, you have the option of following the terms and 500 | conditions either of that numbered version or of any later version published by the 501 | Free Software Foundation. If the Program does not specify a version number of the GNU 502 | General Public License, you may choose any version ever published by the Free 503 | Software Foundation. 504 | 505 | If the Program specifies that a proxy can decide which future versions of the GNU 506 | General Public License can be used, that proxy's public statement of acceptance of a 507 | version permanently authorizes you to choose that version for the Program. 508 | 509 | Later license versions may give you additional or different permissions. However, no 510 | additional obligations are imposed on any author or copyright holder as a result of 511 | your choosing to follow a later version. 512 | 513 | ### 15. Disclaimer of Warranty 514 | 515 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 516 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 517 | PROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER 518 | EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 519 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE 520 | QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE 521 | DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 522 | 523 | ### 16. Limitation of Liability 524 | 525 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY 526 | COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS 527 | PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, 528 | INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 529 | PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE 530 | OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE 531 | WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 532 | POSSIBILITY OF SUCH DAMAGES. 533 | 534 | ### 17. Interpretation of Sections 15 and 16 535 | 536 | If the disclaimer of warranty and limitation of liability provided above cannot be 537 | given local legal effect according to their terms, reviewing courts shall apply local 538 | law that most closely approximates an absolute waiver of all civil liability in 539 | connection with the Program, unless a warranty or assumption of liability accompanies 540 | a copy of the Program in return for a fee. 541 | 542 | _END OF TERMS AND CONDITIONS_ 543 | 544 | ## How to Apply These Terms to Your New Programs 545 | 546 | If you develop a new program, and you want it to be of the greatest possible use to 547 | the public, the best way to achieve this is to make it free software which everyone 548 | can redistribute and change under these terms. 549 | 550 | To do so, attach the following notices to the program. It is safest to attach them 551 | to the start of each source file to most effectively state the exclusion of warranty; 552 | and each file should have at least the “copyright” line and a pointer to 553 | where the full notice is found. 554 | 555 | 556 | Copyright (C) 2017 Jim Hester 557 | 558 | This program is free software: you can redistribute it and/or modify 559 | it under the terms of the GNU General Public License as published by 560 | the Free Software Foundation, either version 3 of the License, or 561 | (at your option) any later version. 562 | 563 | This program is distributed in the hope that it will be useful, 564 | but WITHOUT ANY WARRANTY; without even the implied warranty of 565 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 566 | GNU General Public License for more details. 567 | 568 | You should have received a copy of the GNU General Public License 569 | along with this program. If not, see . 570 | 571 | Also add information on how to contact you by electronic and paper mail. 572 | 573 | If the program does terminal interaction, make it output a short notice like this 574 | when it starts in an interactive mode: 575 | 576 | pkginstall Copyright (C) 2017 Jim Hester 577 | This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. 578 | This is free software, and you are welcome to redistribute it 579 | under certain conditions; type 'show c' for details. 580 | 581 | The hypothetical commands `show w` and `show c` should show the appropriate parts of 582 | the General Public License. Of course, your program's commands might be different; 583 | for a GUI interface, you would use an “about box”. 584 | 585 | You should also get your employer (if you work as a programmer) or school, if any, to 586 | sign a “copyright disclaimer” for the program, if necessary. For more 587 | information on this, and how to apply and follow the GNU GPL, see 588 | <>. 589 | 590 | The GNU General Public License does not permit incorporating your program into 591 | proprietary programs. If your program is a subroutine library, you may consider it 592 | more useful to permit linking proprietary applications with the library. If this is 593 | what you want to do, use the GNU Lesser General Public License instead of this 594 | License. But first, please read 595 | <>. 596 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,pkginstall_result) 4 | export(install_binary) 5 | export(install_package_plan) 6 | importFrom(R6,R6Class) 7 | importFrom(callr,poll) 8 | importFrom(callr,r_process_options) 9 | importFrom(cli,get_spinner) 10 | importFrom(cli,symbol) 11 | importFrom(cliapp,cli_alert_danger) 12 | importFrom(cliapp,cli_alert_info) 13 | importFrom(cliapp,cli_alert_success) 14 | importFrom(cliapp,cli_alert_warning) 15 | importFrom(cliapp,cli_progress_bar) 16 | importFrom(cliapp,cli_text) 17 | importFrom(desc,desc) 18 | importFrom(filelock,lock) 19 | importFrom(filelock,unlock) 20 | importFrom(glue,glue) 21 | importFrom(glue,glue_collapse) 22 | importFrom(glue,single_quote) 23 | importFrom(pkgbuild,pkgbuild_process) 24 | importFrom(prettyunits,pretty_sec) 25 | importFrom(rlang,"%||%") 26 | importFrom(rlang,cnd) 27 | importFrom(rlang,cnd_signal) 28 | importFrom(rlang,error_cnd) 29 | importFrom(rlang,warning_cnd) 30 | importFrom(utils,modifyList) 31 | importFrom(zip,unzip_process) 32 | -------------------------------------------------------------------------------- /R/install.R: -------------------------------------------------------------------------------- 1 | 2 | #' Perform a package installation plan, as created by pkgdepends 3 | #' 4 | #' @param plan Package plan object, returned by pkgdepends 5 | #' @param lib Library directory to install to. 6 | #' @param num_workers Number of worker processes to use. 7 | #' @return Information about the installation process. 8 | #' 9 | #' @importFrom callr poll 10 | #' @export 11 | 12 | install_package_plan <- function(plan, lib = .libPaths()[[1]], 13 | num_workers = 1) { 14 | 15 | start <- Sys.time() 16 | 17 | required_columns <- c( 18 | "type", "binary", "dependencies", "file", "vignettes", 19 | "needscompilation", "metadata", "package") 20 | stopifnot( 21 | inherits(plan, "data.frame"), 22 | all(required_columns %in% colnames(plan)), 23 | is_string(lib), 24 | is_count(num_workers, min = 1L) 25 | ) 26 | 27 | config <- list(lib = lib, num_workers = num_workers) 28 | state <- make_start_state(plan, config) 29 | state$progress <- create_progress_bar(state) 30 | on.exit(done_progress_bar(state), add = TRUE) 31 | 32 | withCallingHandlers({ 33 | 34 | ## Initialise one task for each worker 35 | for (i in seq_len(state$config$num_workers)) { 36 | task <- select_next_task(state) 37 | state <- start_task(state, task) 38 | } 39 | 40 | repeat { 41 | if (are_we_done(state)) break; 42 | update_progress_bar(state) 43 | 44 | events <- poll_workers(state) 45 | state <- handle_events(state, events) 46 | task <- select_next_task(state) 47 | state <- start_task(state, task) 48 | } 49 | }, error = function(e) kill_all_processes(state)) 50 | 51 | create_install_result(state) 52 | } 53 | 54 | make_start_state <- function(plan, config) { 55 | 56 | ## We store the data about build and installation here 57 | install_cols <- data.frame( 58 | stringsAsFactors = FALSE, 59 | build_done = (plan$type %in% c("deps", "installed")) | plan$binary, 60 | build_time = I(rep_list(nrow(plan), as.POSIXct(NA))), 61 | build_error = I(rep_list(nrow(plan), list())), 62 | build_stdout = I(rep_list(nrow(plan), character())), 63 | build_stderr = I(rep_list(nrow(plan), character())), 64 | install_done = plan$type %in% c("deps", "installed"), 65 | install_time = I(rep_list(nrow(plan), as.POSIXct(NA))), 66 | install_error = I(rep_list(nrow(plan), list())), 67 | install_stdout = I(rep_list(nrow(plan), character())), 68 | install_stderr = I(rep_list(nrow(plan), character())), 69 | worker_id = NA_character_ 70 | ) 71 | plan <- cbind(plan, install_cols) 72 | 73 | installed <- plan$package[plan$install_done] 74 | plan$deps_left <- lapply(plan$dependencies, setdiff, installed) 75 | 76 | list( 77 | plan = plan, 78 | workers = list(), 79 | config = config) 80 | } 81 | 82 | are_we_done <- function(state) { 83 | all(state$plan$install_done) 84 | } 85 | 86 | #' @importFrom callr poll 87 | 88 | poll_workers <- function(state) { 89 | if (length(state$workers)) { 90 | timeout <- get_timeout(state) 91 | procs <- lapply(state$workers, "[[", "process") 92 | res <- poll(procs, ms = timeout) 93 | map_lgl(res, function(x) "ready" %in% x) 94 | 95 | } else { 96 | logical() 97 | } 98 | } 99 | 100 | get_timeout <- function(state) 100 101 | 102 | handle_events <- function(state, events) { 103 | for (i in which(events)) state <- handle_event(state, i) 104 | state$workers <- drop_nulls(state$workers) 105 | state 106 | } 107 | 108 | handle_event <- function(state, evidx) { 109 | proc <- state$workers[[evidx]]$process 110 | 111 | ## Read out stdout and stderr. If process is done, then read out all 112 | if (proc$is_alive()) { 113 | state$workers[[evidx]]$stdout <- 114 | c(state$workers[[evidx]]$stdout, out <- proc$read_output(n = 10000)) 115 | state$workers[[evidx]]$stderr <- 116 | c(state$workers[[evidx]]$stderr, err <- proc$read_error(n = 10000)) 117 | } else { 118 | state$workers[[evidx]]$stdout <- 119 | c(state$workers[[evidx]]$stdout, out <- proc$read_all_output()) 120 | state$workers[[evidx]]$stderr <- 121 | c(state$workers[[evidx]]$stderr, err <- proc$read_all_error()) 122 | } 123 | 124 | ## If there is still output, then wait a bit more 125 | if (proc$is_alive() || 126 | proc$is_incomplete_output() || proc$is_incomplete_error()) { 127 | return(state) 128 | } 129 | 130 | ## Otherwise we are done. Remove worker 131 | worker <- state$workers[[evidx]] 132 | state$workers[evidx] <- list(NULL) 133 | 134 | ## Post-process, this will throw on error 135 | if (is.function(proc$get_result)) proc$get_result() 136 | 137 | ## Cut stdout and stderr to lines 138 | worker$stdout <- cut_into_lines(worker$stdout) 139 | worker$stderr <- cut_into_lines(worker$stderr) 140 | 141 | ## Record what was done 142 | stop_task(state, worker) 143 | } 144 | 145 | select_next_task <- function(state) { 146 | 147 | ## Cannot run more workers? 148 | if (length(state$workers) >= state$config$num_workers) { 149 | return(task("idle")) 150 | } 151 | 152 | ## Can we select a source package build? Do that. 153 | can_build <- which( 154 | ! state$plan$build_done & 155 | map_int(state$plan$deps_left, length) == 0 & 156 | is.na(state$plan$worker_id)) 157 | 158 | if (any(can_build)) { 159 | pkgidx <- can_build[1] 160 | return(task("build", pkgidx = pkgidx)) 161 | } 162 | 163 | ## TODO: can we select a binary that is depended on by a source package? 164 | 165 | ## Otherwise select a binary if there is one 166 | can_install <- which( 167 | state$plan$build_done & 168 | ! state$plan$install_done & 169 | is.na(state$plan$worker_id)) 170 | 171 | if (any(can_install)) { 172 | pkgidx <- can_install[1] 173 | return(task("install", pkgidx = pkgidx)) 174 | } 175 | 176 | ## Detect internal error 177 | if (!all(state$plan$install_done) && all(is.na(state$plan$worker_id))) { 178 | stop("Internal error, no task running and cannot select new task") 179 | } 180 | 181 | ## Looks like nothing else to do 182 | task("idle") 183 | } 184 | 185 | task <- function(name, ...) { 186 | list(name = name, args = list(...)) 187 | } 188 | 189 | start_task <- function(state, task) { 190 | if (task$name == "idle") { 191 | state 192 | 193 | } else if (task$name == "build") { 194 | start_task_build(state, task) 195 | 196 | } else if (task$name == "install") { 197 | start_task_install(state, task) 198 | 199 | } else { 200 | stop("Unknown task, internal error") 201 | } 202 | } 203 | 204 | get_worker_id <- (function() { 205 | id <- 0 206 | function() { 207 | id <<- id + 1 208 | as.character(id) 209 | } 210 | })() 211 | 212 | make_build_process <- function(path, tmp_dir, lib, vignettes, 213 | needscompilation) { 214 | 215 | ## with_libpath() is needed for newer callr, which forces the current 216 | ## lib path in the child process. 217 | withr::with_libpaths(lib, action = "prefix", 218 | pkgbuild_process$new( 219 | path, tmp_dir, binary = TRUE, vignettes = vignettes, 220 | needs_compilation = needscompilation, compile_attributes = FALSE, 221 | args = glue("--library={lib}")) 222 | ) 223 | } 224 | 225 | #' @importFrom pkgbuild pkgbuild_process 226 | 227 | start_task_build <- function(state, task) { 228 | pkgidx <- task$args$pkgidx 229 | path <- if (state$plan$type[pkgidx] == "local") { 230 | sub("^file://", "", state$plan$sources[[pkgidx]]) 231 | } else { 232 | state$plan$file[pkgidx] 233 | } 234 | vignettes <- state$plan$vignettes[pkgidx] 235 | needscompilation <- !identical(state$plan$needscompilation[pkgidx], "no") 236 | tmp_dir <- create_temp_dir() 237 | lib <- state$config$lib 238 | 239 | pkg <- state$plan$package[pkgidx] 240 | version <- state$plan$version[pkgidx] 241 | alert("info", "Building {pkg {pkg}} {version {version}}") 242 | 243 | px <- make_build_process(path, tmp_dir, lib, vignettes, needscompilation) 244 | worker <- list(id = get_worker_id(), task = task, process = px, 245 | stdout = character(), stderr = character()) 246 | state$workers <- c( 247 | state$workers, structure(list(worker), names = worker$id)) 248 | state$plan$worker_id[pkgidx] <- worker$id 249 | state$plan$build_time[[pkgidx]] <- Sys.time() 250 | state 251 | } 252 | 253 | start_task_install <- function(state, task) { 254 | pkgidx <- task$args$pkgidx 255 | filename <- state$plan$file[pkgidx] 256 | lib <- state$config$lib 257 | metadata <- state$plan$metadata[[pkgidx]] 258 | 259 | pkg <- state$plan$package[pkgidx] 260 | version <- state$plan$version[pkgidx] 261 | update_progress_bar(state) 262 | 263 | px <- make_install_process(filename, lib = lib, metadata = metadata) 264 | worker <- list( 265 | id = get_worker_id(), task = task, process = px, 266 | stdout = character(), stderr = character()) 267 | 268 | state$workers <- c( 269 | state$workers, structure(list(worker), names = worker$id)) 270 | state$plan$worker_id[pkgidx] <- worker$id 271 | state$plan$install_time[[pkgidx]] <- Sys.time() 272 | state 273 | } 274 | 275 | stop_task <- function(state, worker) { 276 | if (worker$task$name == "build") { 277 | stop_task_build(state, worker) 278 | 279 | } else if (worker$task$name == "install") { 280 | stop_task_install(state, worker) 281 | 282 | } else { 283 | stop("Unknown task, internal error") 284 | } 285 | } 286 | 287 | #' @importFrom prettyunits pretty_sec 288 | 289 | stop_task_build <- function(state, worker) { 290 | 291 | ## TODO: make sure exit status is non-zero on build error! 292 | success <- worker$process$get_exit_status() == 0 293 | 294 | pkgidx <- worker$task$args$pkgidx 295 | pkg <- state$plan$package[pkgidx] 296 | version <- state$plan$version[pkgidx] 297 | time <- Sys.time() - state$plan$build_time[[pkgidx]] 298 | ptime <- pretty_sec(as.numeric(time, units = "secs")) 299 | 300 | if (success) { 301 | alert("success", "Built {pkg {pkg}} {version {version}} \\ 302 | {timestamp {ptime}}") 303 | ## Need to save the name of the built package 304 | state$plan$file[pkgidx] <- worker$process$get_built_file() 305 | } else { 306 | alert("danger", "Failed to build {pkg {pkg}} \\ 307 | {version {version}} {timestamp {ptime}}") 308 | } 309 | update_progress_bar(state, 1L) 310 | 311 | state$plan$build_done[[pkgidx]] <- TRUE 312 | state$plan$build_time[[pkgidx]] <- time 313 | state$plan$build_error[[pkgidx]] <- ! success 314 | state$plan$build_stdout[[pkgidx]] <- worker$stdout 315 | state$plan$build_stderr[[pkgidx]] <- worker$stderr 316 | state$plan$worker_id[[pkgidx]] <- NA_character_ 317 | 318 | if (!success) { 319 | abort("Failed to build source package {pkg}.") 320 | } 321 | 322 | state 323 | } 324 | 325 | installed_note <- function(pkg) { 326 | 327 | standard_note <- function() { 328 | if (pkg$type %in% c("cran", "standard")) { 329 | "" 330 | } else { 331 | paste0("(", pkg$type, ")") 332 | } 333 | } 334 | 335 | github_note <- function() { 336 | meta <- pkg$metadata[[1]] 337 | paste0("(github::", meta[["RemoteUsername"]], "/", meta[["RemoteRepo"]], 338 | "@", substr(meta[["RemoteSha"]], 1, 7), ")") 339 | } 340 | 341 | switch( 342 | pkg$type, 343 | cran = "", 344 | bioc = "(BioC)", 345 | standard = standard_note(), 346 | local = "(local)", 347 | github = github_note() 348 | ) 349 | } 350 | 351 | #' @importFrom prettyunits pretty_sec 352 | 353 | stop_task_install <- function(state, worker) { 354 | 355 | ## TODO: make sure the install status is non-zero on exit 356 | success <- worker$process$get_exit_status() == 0 357 | 358 | pkgidx <- worker$task$args$pkgidx 359 | pkg <- state$plan$package[pkgidx] 360 | version <- state$plan$version[pkgidx] 361 | time <- Sys.time() - state$plan$install_time[[pkgidx]] 362 | ptime <- pretty_sec(as.numeric(time, units = "secs")) 363 | note <- installed_note(state$plan[pkgidx,]) 364 | 365 | if (success) { 366 | alert("success", "Installed {pkg {pkg}} \\ 367 | {version {version}} {note} {timestamp {ptime}}") 368 | } else { 369 | alert("danger", "Failed to install {pkg pkg}} {version {version}}") 370 | } 371 | update_progress_bar(state, 1L) 372 | 373 | state$plan$install_done[[pkgidx]] <- TRUE 374 | state$plan$install_time[[pkgidx]] <- time 375 | state$plan$install_error[[pkgidx]] <- ! success 376 | state$plan$install_stdout[[pkgidx]] <- worker$stdout 377 | state$plan$install_stderr[[pkgidx]] <- worker$stderr 378 | state$plan$worker_id[[pkgidx]] <- NA_character_ 379 | 380 | if (!success) { 381 | abort("Failed to install binary package {pkg}.") 382 | } 383 | 384 | ## Need to remove from the dependency list 385 | state$plan$deps_left <- lapply(state$plan$deps_left, setdiff, pkg) 386 | 387 | state 388 | } 389 | 390 | create_install_result <- function(state) { 391 | result <- state$plan 392 | class(result) <- c("pkginstall_result", class(result)) 393 | result 394 | } 395 | 396 | #' @export 397 | #' @importFrom prettyunits pretty_sec 398 | 399 | print.pkginstall_result <- function(x, ...) { 400 | newly <- sum(x$lib_status == "new") 401 | upd <- sum(x$lib_status == "update") 402 | noupd <- sum(x$lib_status == "no-update") 403 | curr <- sum(x$lib_status == "current") 404 | if (newly) cat("Installed: ", newly, "\n", sep = "") 405 | if (upd) cat("Updated: ", upd, "\n", sep = "") 406 | if (noupd) cat("Not updated:", noupd, "\n", sep = "") 407 | if (curr) cat("Current: ", curr, "\n", sep = "") 408 | 409 | ## TODO 410 | build_time <- sum(unlist(x$build_time), na.rm = TRUE) 411 | inst_time <- sum(unlist(x$install_time), na.rm = TRUE) 412 | 413 | cat("Build time: ", pretty_sec(build_time), "\n", sep = "") 414 | cat("Intall time: ", pretty_sec(inst_time), "\n", sep = "") 415 | 416 | invisible(x) 417 | } 418 | 419 | kill_all_processes <- function(state) { 420 | alive <- FALSE 421 | for (i in seq_along(state$workers)) { 422 | proc <- state$workers[[i]]$process 423 | proc$signal(tools::SIGINT) 424 | alive <- alive || proc$is_alive() 425 | } 426 | 427 | if (alive) { 428 | for (i in seq_along(state$workers)) { 429 | proc <- state$workers[[i]]$process 430 | proc$wait(200) 431 | proc$kill_tree() 432 | } 433 | } 434 | } 435 | -------------------------------------------------------------------------------- /R/install_binary.R: -------------------------------------------------------------------------------- 1 | #' Install a R binary package 2 | #' 3 | #' @param filename filename of built binary package to install 4 | #' @param lib library to install packages into 5 | #' @param metadata Named character vector of metadata entries to be added 6 | #' to the \code{DESCRIPTION} after installation. 7 | #' @param quiet Whether to suppress console output. 8 | #' @importFrom filelock lock unlock 9 | #' @importFrom rlang cnd cnd_signal 10 | #' @importFrom cliapp cli_progress_bar cli_alert_success 11 | #' @export 12 | install_binary <- function(filename, lib = .libPaths()[[1L]], 13 | metadata = NULL, quiet = NULL) { 14 | 15 | stopifnot( 16 | is_string(filename), file.exists(filename), 17 | is_string(lib), 18 | all_named(metadata), 19 | is.null(quiet) || is_flag(quiet)) 20 | 21 | quiet <- quiet %||% ! is_verbose() 22 | 23 | px <- make_install_process(filename, lib = lib, metadata = metadata) 24 | stdout <- "" 25 | stderr <- "" 26 | 27 | bar <- cli_progress_bar( 28 | format = paste0(":spin Installing ", filename)) 29 | 30 | repeat { 31 | px$poll_io(100) 32 | if (!quiet) bar$tick(0) 33 | stdout <- paste0(stdout, px$read_output()) 34 | stderr <- paste0(stderr, px$read_error()) 35 | if (!px$is_alive() && 36 | !px$is_incomplete_output() && !px$is_incomplete_error()) { 37 | break 38 | } 39 | } 40 | 41 | if (!quiet) bar$terminate() 42 | if (px$get_exit_status() != 0) { 43 | stop("Package installation failed\n", stderr) 44 | } 45 | 46 | cli_alert_success(paste0("Installed ", filename)) 47 | 48 | invisible(px$get_result()) 49 | } 50 | 51 | install_extracted_binary <- function(filename, lib_cache, pkg_cache, lib, 52 | metadata, now) { 53 | 54 | pkg <- verify_extracted_package(filename, pkg_cache) 55 | add_metadata(pkg$path, metadata) 56 | pkg_name <- pkg$name 57 | 58 | lockfile <- lock_cache(lib_cache, pkg_name, getOption("install.lock")) 59 | on.exit(unlock(lockfile), add = TRUE) 60 | 61 | installed_path <- file.path(lib, pkg_name) 62 | if (file.exists(installed_path)) { 63 | # First move the existing library (which still works even if a process has 64 | # the DLL open), then try to delete it, which may fail if another process 65 | # has the file open. Some points: 66 | # - the / directory might exist with the leftovers 67 | # of a previous installation, typically because the DLL file was/is 68 | # locked, so we could not delete it after the move. 69 | # - so we create a random path component to avoid interference 70 | # - we also unlink() the whole package-specific cache directory, 71 | # to avoid accumulating junk there. This is safe, well, if we are 72 | # locking, which is strongly suggested. 73 | move_to <- file.path(lib_cache, pkg_name, basename(tempfile())) 74 | unlink(dirname(move_to), recursive = TRUE, force = TRUE) 75 | dir.create(dirname(move_to), showWarnings = FALSE, recursive = TRUE) 76 | ret <- file.rename(installed_path, move_to) 77 | if (!ret) { 78 | abort(type = "filesystem", 79 | "Failed to move installed package at {installed_path}", 80 | package = pkg_name) 81 | } 82 | ret <- unlink(move_to, recursive = TRUE, force = TRUE) 83 | if (ret != 0) { 84 | warn(type = "filesystem", 85 | "Failed to remove installed package at {move_to}", 86 | package = pkg_name) 87 | } 88 | } 89 | ret <- file.rename(pkg$path, installed_path) 90 | if (!ret) { 91 | abort(type = "filesystem", 92 | "Unable to move package from {pkg$path} to {installed_path}", 93 | package = pkg_name) 94 | } 95 | 96 | cnd_signal( 97 | cnd("pkginstall_installed", 98 | package = pkg_name, path = installed_path, time = Sys.time() - now, type = "binary")) 99 | 100 | installed_path 101 | } 102 | 103 | #' @importFrom utils modifyList 104 | add_metadata <- function(pkg_path, metadata) { 105 | if (!length(metadata)) return() 106 | 107 | ## During installation, the DESCRIPTION file is read and an package.rds 108 | ## file created with most of the information from the DESCRIPTION file. 109 | ## Functions that read package metadata may use either the DESCRIPTION 110 | ## file or the package.rds file, therefore we attempt to modify both of 111 | ## them, and return an error if neither one exists. 112 | 113 | source_desc <- file.path(pkg_path, "DESCRIPTION") 114 | binary_desc <- file.path(pkg_path, "Meta", "package.rds") 115 | if (file.exists(source_desc)) { 116 | do.call(desc::desc_set, c(as.list(metadata), list(file = source_desc))) 117 | } 118 | 119 | if (file.exists(binary_desc)) { 120 | pkg_desc <- base::readRDS(binary_desc) 121 | desc <- as.list(pkg_desc$DESCRIPTION) 122 | desc <- modifyList(desc, as.list(metadata)) 123 | pkg_desc$DESCRIPTION <- stats::setNames(as.character(desc), names(desc)) 124 | base::saveRDS(pkg_desc, binary_desc) 125 | } 126 | 127 | if (!file.exists(source_desc) && !file.exists(binary_desc)) { 128 | stop("No DESCRIPTION found!", call. = FALSE) 129 | } 130 | } 131 | -------------------------------------------------------------------------------- /R/install_binary_process.R: -------------------------------------------------------------------------------- 1 | 2 | make_install_process <- function(filename, lib = .libPaths()[[1L]], 3 | metadata = NULL) { 4 | filename; lib; metadata 5 | 6 | now <- Sys.time() 7 | 8 | type <- detect_package_archive_type(filename) 9 | if (type == "unknown") { 10 | abort(type = "invalid_input", 11 | "Cannot extract {filename}, unknown archive type?") 12 | } 13 | 14 | lib_cache <- library_cache(lib) 15 | mkdirp(pkg_cache <- tempfile(tmpdir = lib_cache)) 16 | 17 | ppfun <- function() { 18 | install_extracted_binary(filename, lib_cache, pkg_cache, lib, 19 | metadata, now) 20 | } 21 | 22 | p <- if (type == "zip") { 23 | make_unzip_process(filename, exdir = pkg_cache, post_process = ppfun) 24 | } else { 25 | ## TODO: we already know the package type, no need to detect again 26 | make_untar_process(filename, exdir = pkg_cache, post_process = ppfun) 27 | } 28 | 29 | reg.finalizer(p, function(...) unlink(pkg_cache, recursive = TRUE), 30 | onexit = TRUE) 31 | 32 | p 33 | } 34 | -------------------------------------------------------------------------------- /R/pkginstall.R: -------------------------------------------------------------------------------- 1 | 2 | #' Intall Packages from Local Files 3 | #' 4 | #' Provides a replacement for `utils::install.packages(repo = NULL)`. 5 | #' I.e. it builds binary packages from source packages, and extracts the 6 | #' compressed archives into the package library. 7 | #' 8 | #' @section Features: 9 | #' 10 | #' Compared to `utils::install.packages()` it 11 | #' 12 | #' - Has robust support for installing packages in parallel. 13 | #' - Fails immediately when the first package fails when installing 14 | #' multiple packages, rather than returning a warning. 15 | #' - Uses the same code paths on all platforms, rather than similar (but 16 | #' not identical) code paths. 17 | #' - Succeeds or fails atomically. Either the complete package is installed 18 | #' or it fails with an informative error message. 19 | #' - Has additional tests for package validity before installing 20 | #' - Always uses per-package lock files, to protect against simultaneous 21 | #' installation. 22 | #' - Has a robust set of tests, to ensure correctness and ease debugging 23 | #' installation issues. 24 | #' 25 | #' @section Locking: 26 | #' 27 | #' pkginstall uses the `install.lock` option. If this is set to `FALSE`, 28 | #' then no locking is performed. For all other values (including if the 29 | #' option is unset or is `NULL`), per-package lock files are used, via the 30 | #' filelock package. 31 | #' 32 | "_PACKAGE" 33 | -------------------------------------------------------------------------------- /R/progress-bar.R: -------------------------------------------------------------------------------- 1 | 2 | pkg_data <- new.env() 3 | 4 | progress_chars <- function() { 5 | if (is.null(pkg_data$chars)) { 6 | if (cli::is_utf8_output()) { 7 | pkg_data$chars <- list( 8 | build = "\U0001f4e6", 9 | inst = "\u2705", 10 | lpar = "\u2e28", 11 | rpar = "\u2e29", 12 | fill = "\u2588", 13 | half = "\u2592" 14 | 15 | ) 16 | } else { 17 | pkg_data$chars <- list( 18 | build = crayon::bgGreen(" B "), 19 | inst = crayon::bgGreen(" I "), 20 | lpar = "(", 21 | rpar = ")", 22 | fill = "#", 23 | half = "-" 24 | ) 25 | } 26 | } 27 | 28 | pkg_data$chars 29 | } 30 | 31 | #' @importFrom cli symbol 32 | #' @importFrom cliapp cli_alert_success cli_alert_info cli_alert_warning 33 | #' cli_alert_danger cli_text 34 | 35 | alert <- function(type, msg, .envir = parent.frame()) { 36 | if (!is_verbose()) return() 37 | if (have_rstudio_bug_2387()) { 38 | switch( 39 | type, 40 | success = cli_text(paste(symbol$tick, msg), .envir = .envir), 41 | info = cli_text(paste(symbol$info, msg), .envir = .envir), 42 | warning = cli_alert_warning(msg, .envir = .envir), 43 | danger = cli_alert_danger(msg, .envir = .envir) 44 | ) 45 | } else { 46 | switch ( 47 | type, 48 | success = cliapp::cli_alert_success(msg, .envir = .envir), 49 | info = cli_alert_info(msg, .envir = .envir), 50 | warning = cli_alert_warning(msg, .envir = .envir), 51 | danger = cli_alert_danger(msg, .envir = .envir) 52 | ) 53 | } 54 | } 55 | 56 | #' @importFrom cli get_spinner 57 | 58 | create_progress_bar <- function(state) { 59 | if (!is_verbose()) return() 60 | pkg_data$spinner <- get_spinner() 61 | pkg_data$spinner_state <- 1L 62 | 63 | cli_progress_bar( 64 | format = ":xbar ETA :eta | :xbuilt | :xinst | :xmsg", 65 | total = sum(!state$plan$build_done) + sum(!state$plan$install_done), 66 | force = TRUE 67 | ) 68 | } 69 | 70 | update_progress_bar <- function(state, tick = 0) { 71 | 72 | if (!is_verbose()) return() 73 | 74 | plan <- state$plan 75 | total <- nrow(plan) 76 | installed <- sum(plan$install_done) 77 | built <- sum(plan$build_done) 78 | 79 | building <- sum(buildingl <- !plan$build_done & !is.na(plan$worker_id)) 80 | installing <- sum(!buildingl & !is.na(plan$worker_id)) 81 | 82 | ## This is a workaround for an RStudio bug: 83 | ## https://github.com/r-lib/pkginstall/issues/42 84 | pp <- if (Sys.getenv("RSTUDIO", "") == "" || 85 | Sys.getenv("RSTUDIO_TERM", "") != "") { 86 | function(x) x 87 | } else { 88 | function(x) crayon::strip_style(x) 89 | } 90 | 91 | chars <- progress_chars() 92 | tokens <- list( 93 | xbar = pp(make_bar(installed / total, built/total, width = 15)), 94 | xbuilt = pp(make_progress_block(chars$build, built, total, building)), 95 | xinst = pp(make_progress_block(chars$inst, installed, total, installing)), 96 | xmsg = pp(make_trailing_progress_msg(state)) 97 | ) 98 | 99 | saveRDS(tokens, "/tmp/tok.rds") 100 | 101 | state$progress$tick(tick, tokens = tokens) 102 | } 103 | 104 | ## p1 <= p2 must hold 105 | 106 | make_bar <- function(p1, p2, width) { 107 | width <- width - 2L 108 | 109 | w1 <- if (isTRUE(all.equal(p1, 1))) width else trunc(width * p1) 110 | w2 <- if (isTRUE(all.equal(p2, 1))) width - w1 else trunc(width * (p2 - p1)) 111 | 112 | chars <- progress_chars() 113 | p1chars <- rep(chars$fill, w1) 114 | p2chars <- rep(chars$half, w2) 115 | xchars <- rep(" ", max(width - w1 - w2, 0)) 116 | bar <- paste( 117 | c(chars$lpar, p1chars, p2chars, xchars, chars$rpar), collapse = "") 118 | 119 | ## This is a workaround for an RStudio bug: 120 | ## https://github.com/r-lib/pkginstall/issues/42 121 | if (Sys.getenv("RSTUDIO", "") == "" || 122 | Sys.getenv("RSTUDIO_TERM", "") != "") { 123 | crayon::green(bar) 124 | } else { 125 | bar 126 | } 127 | } 128 | 129 | make_progress_block <- function(sym, done, total, prog) { 130 | spin <- pkg_data$spinner$frames[[pkg_data$spinner_state]] 131 | pkg_data$spinner_state <- 132 | pkg_data$spinner_state %% length(pkg_data$spinner$frames) + 1L 133 | paste0( 134 | sym, " ", 135 | done, "/", total, 136 | if (prog) paste0(" ", spin, " ", prog) else " " 137 | ) 138 | } 139 | 140 | done_progress_bar <- function(state) { 141 | if (!is_verbose()) return() 142 | state$progress$terminate() 143 | } 144 | 145 | make_trailing_progress_msg <- function(state) { 146 | working <- !is.na(state$plan$worker_id) 147 | installing <- state$plan$build_done & working 148 | building <- !state$plan$build_done & working 149 | 150 | building_pkgs <- paste(state$plan$package[building], collapse = ", ") 151 | installing_pkgs <- paste(state$plan$package[installing], collapse = ", ") 152 | 153 | paste0( 154 | if (any(building)) paste0("building ", building_pkgs), 155 | if (any(building) && any(installing)) ", ", 156 | if (any(installing)) paste0("installing ", installing_pkgs) 157 | ) 158 | } 159 | -------------------------------------------------------------------------------- /R/tar.R: -------------------------------------------------------------------------------- 1 | 2 | #' Create a tar background process 3 | #' 4 | #' Use an external tar program, if there is a working one, otherwise use 5 | #' the internal implementation. 6 | #' 7 | #' When using the internal implementation, we need to start another R 8 | #' process. 9 | #' 10 | #' @param tarfile Tar file. 11 | #' @param files Files or regular expressions to set what to extract. if 12 | #' `NULL` then everything is extracted. 13 | #' @param exdir Where to extract the archive. It must exist. 14 | #' @param restore_times Whether to restore file modification times. 15 | #' @param post_process Function to call after the extraction. 16 | #' @return The [callr::process] object. 17 | #' @keywords internal 18 | 19 | make_untar_process <- function(tarfile, files = NULL, exdir = ".", 20 | restore_times = TRUE, post_process = NULL) { 21 | internal <- need_internal_tar() 22 | if (internal) { 23 | r_untar_process$new(tarfile, files, exdir, restore_times, 24 | post_process = post_process) 25 | } else { 26 | external_untar_process$new(tarfile, files, exdir, restore_times, 27 | post_process = post_process) 28 | } 29 | } 30 | 31 | #' Check if we need to use R's internal tar implementation 32 | #' 33 | #' This is slow, because we need to start an R child process, and the 34 | #' implementation is also very slow. So it is better to use an extranl tar 35 | #' program, if we can. We test this by trying to uncompress a .tar.gz 36 | #' archive using the external program. The name of the tar program is 37 | #' taken from the `TAR` environment variable, if this is unset then `tar` 38 | #' is used. 39 | #' 40 | #' @return Whether we need to use the internal tar implementation. 41 | #' @keywords internal 42 | 43 | need_internal_tar <- local({ 44 | internal <- NULL 45 | function() { 46 | if (!is.null(internal)) return(internal) 47 | 48 | mkdirp(tmp <- tempfile()) 49 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 50 | tarfile <- system.file(package = .packageName, "tools", "pkg_1.0.0.tgz") 51 | 52 | tryCatch( 53 | p <- external_untar_process$new(tarfile, exdir = tmp), 54 | error = function(e) { 55 | internal <<- TRUE 56 | } 57 | ) 58 | if (!is.null(internal)) return(internal) 59 | 60 | p$wait(timeout = 2000) 61 | p$kill() 62 | internal <<- p$get_exit_status() != 0 || 63 | !file.exists(file.path(tmp, "pkg", "DESCRIPTION")) 64 | internal 65 | } 66 | }) 67 | 68 | #' @importFrom R6 R6Class 69 | 70 | external_untar_process <- R6Class( 71 | "external_untar_process", 72 | inherit = callr::process, 73 | 74 | public = list( 75 | initialize = function(tarfile, files = NULL, exdir = ".", 76 | restore_times = TRUE, 77 | tar = Sys.getenv("TAR", "tar"), 78 | post_process = NULL) 79 | eup_init(self, private, super, tarfile, files, exdir, 80 | restore_times, tar, post_process) 81 | ), 82 | 83 | private = list( 84 | options = NULL 85 | ) 86 | ) 87 | 88 | r_untar_process <- R6Class( 89 | "r_untar_process", 90 | inherit = callr::r_process, 91 | 92 | public = list( 93 | initialize = function(tarfile, files = NULL, exdir = ".", 94 | restore_times = TRUE, post_process = NULL) 95 | runtar_init(self, private, super, tarfile, files, exdir, 96 | restore_times, tar, post_process) 97 | ), 98 | 99 | private = list( 100 | options = NULL 101 | ) 102 | ) 103 | 104 | eup_init <- function(self, private, super, tarfile, files, exdir, 105 | restore_times, tar, post_process) { 106 | 107 | private$options <- list( 108 | tarfile = normalizePath(tarfile), 109 | files = files, 110 | exdir = exdir, 111 | restore_times = restore_times, 112 | tar = tar) 113 | 114 | private$options$args <- eup_get_args(private$options) 115 | super$initialize(tar, private$options$args, post_process = post_process, 116 | stdout = "|", stderr = "|") 117 | invisible(self) 118 | } 119 | 120 | eup_get_args <- function(options) { 121 | c( 122 | "-x", "-f", options$tarfile, 123 | "-C", options$exdir, 124 | get_untar_decompress_arg(options$tarfile), 125 | if (! options$restore_times) "-m", 126 | options$files 127 | ) 128 | } 129 | 130 | get_untar_decompress_arg <- function(tarfile) { 131 | type <- detect_package_archive_type(tarfile) 132 | switch( 133 | type, 134 | "gzip" = "-z", 135 | "bzip2" = "-j", 136 | "xz" = "-J", 137 | "zip" = stop("Not a tar file, looks like a zip file"), 138 | "unknown" = character() 139 | ) 140 | } 141 | 142 | detect_package_archive_type <- function(file) { 143 | buf <- readBin(file, what = "raw", n = 6) 144 | if (is_gzip(buf)) { 145 | "gzip" 146 | } else if (is_zip(buf)) { 147 | "zip" 148 | } else if (is_bzip2(buf)) { 149 | "bzip2" 150 | } else if (is_xz(buf)) { 151 | "xz" 152 | } else { 153 | "unknown" 154 | } 155 | } 156 | 157 | is_gzip <- function(buf) { 158 | if (!is.raw(buf)) buf <- readBin(buf, what = "raw", n = 3) 159 | length(buf) >= 3 && 160 | buf[1] == 0x1f && 161 | buf[2] == 0x8b && 162 | buf[3] == 0x08 163 | } 164 | 165 | is_bzip2 <- function(buf) { 166 | if (!is.raw(buf)) buf <- readBin(buf, what = "raw", n = 3) 167 | length(buf) >= 3 && 168 | buf[1] == 0x42 && 169 | buf[2] == 0x5a && 170 | buf[3] == 0x68 171 | } 172 | 173 | is_xz <- function(buf) { 174 | if (!is.raw(buf)) buf <- readBin(buf, what = "raw", n = 6) 175 | length(buf) >= 6 && 176 | buf[1] == 0xFD && 177 | buf[2] == 0x37 && 178 | buf[3] == 0x7A && 179 | buf[4] == 0x58 && 180 | buf[5] == 0x5A && 181 | buf[6] == 0x00 182 | } 183 | 184 | is_zip <- function(buf) { 185 | if (!is.raw(buf)) buf <- readBin(buf, what = "raw", n = 4) 186 | length(buf) >= 4 && 187 | buf[1] == 0x50 && 188 | buf[2] == 0x4b && 189 | (buf[3] == 0x03 || buf[3] == 0x05 || buf[5] == 0x07) && 190 | (buf[4] == 0x04 || buf[4] == 0x06 || buf[4] == 0x08) 191 | } 192 | 193 | #' @importFrom callr r_process_options 194 | 195 | runtar_init <- function(self, private, super, tarfile, files, exdir, 196 | restore_times, tar, post_process) { 197 | 198 | options <- list( 199 | tarfile = normalizePath(tarfile), 200 | files = files, 201 | exdir = exdir, 202 | restore_times = restore_times, 203 | tar = tar, 204 | post_process = post_process) 205 | 206 | process_options <- r_process_options() 207 | process_options$func <- function(options) { 208 | # nocov start 209 | ret <- utils::untar( 210 | tarfile = options$tarfile, 211 | files = options$files, 212 | list = FALSE, 213 | exdir = options$exdir, 214 | compressed = NA, 215 | restore_times = options$restore_times, 216 | tar = "internal" 217 | ) 218 | 219 | if (!is.null(options$post_process)) options$post_process() else ret 220 | # nocov end 221 | } 222 | process_options$args <- list(options = options) 223 | super$initialize(process_options) 224 | } 225 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' @importFrom glue single_quote glue_collapse 2 | collapse_quote_transformer <- function(code, envir) { 3 | collapse_re <- "[*]$" 4 | quote_re <- "^[|]" 5 | should_collapse <- grepl(collapse_re, code) 6 | should_quote <- !grepl(quote_re, code) 7 | code <- sub(collapse_re, "", 8 | sub(quote_re, "", code)) 9 | res <- eval(parse(text = code, keep.source = FALSE), envir = envir) 10 | if (should_quote) { 11 | res <- single_quote(res) 12 | } 13 | if (should_collapse) { 14 | res <- glue_collapse(res, sep = ", ", last = " and ") 15 | } 16 | res 17 | } 18 | 19 | #' @importFrom rlang error_cnd 20 | #' @importFrom glue glue 21 | abort <- function(msg, type = NULL, ..., .envir = parent.frame()) { 22 | stop( 23 | error_cnd( 24 | .subclass = type, ..., 25 | message = glue(msg, 26 | .envir = parent.frame(), 27 | .transformer = collapse_quote_transformer), 28 | )) 29 | } 30 | 31 | #' @importFrom rlang warning_cnd 32 | warn <- function(msg, type = NULL, ..., .envir = parent.frame()) { 33 | warning( 34 | warning_cnd( 35 | .subclass = type, ..., 36 | message = glue(msg, 37 | .envir = parent.frame(), 38 | .transformer = collapse_quote_transformer), 39 | )) 40 | } 41 | 42 | is_loaded <- function(package) { 43 | package %in% loadedNamespaces() 44 | } 45 | 46 | create_temp_dir <- function(..., tmpdir = tempdir()) { 47 | f <- tempfile(tmpdir = tmpdir, ...) 48 | dir.create(f) 49 | f 50 | } 51 | 52 | library_cache <- function(lib) { 53 | lib_cache <- file.path(lib, "_cache") 54 | dir.create(lib_cache, recursive = TRUE, showWarnings = FALSE) 55 | lib_cache 56 | } 57 | 58 | lock_cache <- function(cache, pkg_name, lock = TRUE) { 59 | use_lock <- !identical(lock, FALSE) 60 | my_lock <- NULL 61 | if (use_lock) { 62 | lockfile <- file.path(cache, glue("{pkg_name}.lock")) 63 | # TODO: timeout and fail? 64 | my_lock <- lock(lockfile) 65 | } 66 | my_lock 67 | } 68 | 69 | unlock <- function(lock) { 70 | if (is.null(lock)) { 71 | return() 72 | } 73 | filelock::unlock(lock) 74 | } 75 | 76 | 77 | sysname <- function() { 78 | res <- tolower(Sys.info()[["sysname"]]) 79 | map <- c(darwin = "mac", "sunos" = "solaris")[res] 80 | res[!is.na(map)] <- map 81 | res 82 | } 83 | 84 | map_lgl <- get("map_lgl", asNamespace("rlang")) 85 | 86 | map_chr <- get("map_chr", asNamespace("rlang")) 87 | 88 | map_int <- get("map_int", asNamespace("rlang")) 89 | 90 | #' @importFrom rlang %||% 91 | 92 | is_verbose <- function() { 93 | env <- Sys.getenv("R_PKG_SHOW_PROGRESS", "") 94 | if (env != "") { 95 | tolower(env) == "true" 96 | } else { 97 | opt <- getOption("pkg.show_progress") 98 | if (!is.null(opt)) { 99 | isTRUE(opt) 100 | } else { 101 | interactive() 102 | } 103 | } 104 | } 105 | 106 | mkdirp <- function(x) { 107 | dir.create(x, showWarnings = FALSE, recursive = TRUE) 108 | } 109 | 110 | str_trim <- function(x) { 111 | sub("\\s$", "", sub("^\\s+", "", x)) 112 | } 113 | 114 | rep_list <- function(n, expr) { 115 | lapply(integer(n), eval.parent(substitute(function(...) expr))) 116 | } 117 | 118 | drop_nulls <- function(x) { 119 | is_null <- map_lgl(x, is.null) 120 | x[!is_null] 121 | } 122 | 123 | cut_into_lines <- function(x) { 124 | x <- do.call(paste0, as.list(x)) 125 | x <- gsub("\r\n", "\n", x, fixed = TRUE) 126 | x <- strsplit(x, "\n", fixed = TRUE)[[1]] 127 | if (length(x)) x else "" 128 | } 129 | 130 | is_string <- function(x) { 131 | is.character(x) && length(x) == 1 && !is.na(x) 132 | } 133 | 134 | is_flag <- function(x) { 135 | is.logical(x) && length(x) == 1 && !is.na(x) 136 | } 137 | 138 | is_count <- function(x, min = 0L) { 139 | is.numeric(x) && length(x) == 1 && !is.na(x) && 140 | as.integer(x) == x && x >= min 141 | } 142 | 143 | all_named <- function(x) { 144 | length(names(x)) == length(x) && all(names(x) != "") 145 | } 146 | 147 | 148 | is_rstudio_version <- function(ver) { 149 | tryCatch( 150 | rstudioapi::getVersion() >= ver, 151 | error = function(e) FALSE 152 | ) 153 | } 154 | 155 | have_rstudio_bug_2387 <- function() { 156 | if (!is.null(r <- pkg_data$rstudio_bug_2387)) return(r) 157 | r <- pkg_data$rstudio_bug_2387 <- 158 | Sys.getenv("RSTUDIO", "") != "" && 159 | Sys.getenv("RSTUDIO_TERM", "") == "" && 160 | !is_rstudio_version("1.2.128") 161 | r 162 | } 163 | -------------------------------------------------------------------------------- /R/verify_binary.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom desc desc 3 | 4 | verify_extracted_package <- function(filename, parent_path) { 5 | 6 | pkg_name <- dir(parent_path) 7 | pkg_path <- file.path(parent_path, pkg_name) 8 | 9 | if (length(pkg_name) == 0) { 10 | abort(type = "invalid_input", 11 | "{filename} is not a valid R package, it is an empty archive") 12 | 13 | } else if (length(pkg_name) > 1) { 14 | abort(type = "invalid_input", 15 | "{filename} is not a valid R package, it should contain a 16 | single directory") 17 | } 18 | 19 | rel_package_files <- c( 20 | file.path(pkg_name, "Meta", "package.rds"), 21 | file.path(pkg_name, "DESCRIPTION") 22 | ) 23 | package_files <- file.path(parent_path, rel_package_files) 24 | 25 | has_files <- file.exists(package_files) 26 | if (!all(has_files)) { 27 | miss <- rel_package_files[! has_files] 28 | abort(type = "invalid_input", 29 | "{filename} is not a valid binary, it does not contain {miss*}.", 30 | package = pkg_name) 31 | } 32 | 33 | rel_dsc_file <- file.path(pkg_name, "DESCRIPTION") 34 | dsc_file <- file.path(pkg_path, "DESCRIPTION") 35 | dsc <- tryCatch( 36 | desc(dsc_file), 37 | error = function(e) { 38 | abort(type = "invalid_input", 39 | "{filename} is not a valid binary, invalid {rel_dsc_file}.", 40 | package = pkg_name) 41 | } 42 | ) 43 | 44 | if (!length(dsc$fields())) { 45 | abort(type = "invalid_input", 46 | "{filename} is not a valid binary, {rel_dsc_file} is empty.", 47 | package = pkg_name) 48 | } 49 | 50 | dsc_pkg <- dsc$get("Package") 51 | if (is.na(dsc_pkg)) { 52 | abort(type = "invalid_input", 53 | "{filename} has no `Package` entry in {rel_dsc_file}", 54 | package = pkg_name) 55 | } 56 | 57 | if (pkg_name != str_trim(dsc_pkg[[1]])) { 58 | abort(type = "invalid_input", 59 | "{filename} is not a valid binary, package name mismatch in 60 | archive and in {rel_dsc_file}", 61 | package = pkg_name) 62 | } 63 | 64 | if (is.na(dsc$get("Built"))) { 65 | abort(type = "invalid_input", 66 | "{filename} is not a valid binary, no 'Built' entry in {rel_dsc_file}.", 67 | package = pkg_name) 68 | } 69 | 70 | list(name = pkg_name, path = pkg_path, desc = dsc) 71 | } 72 | -------------------------------------------------------------------------------- /R/zip.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom zip unzip_process 3 | 4 | make_unzip_process <- function(zipfile, exdir = ".", post_process = NULL) { 5 | up <- unzip_process() 6 | up$new(zipfile, exdir = exdir, post_process = post_process, 7 | stdout = "|", stderr = "|") 8 | } 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # pkginstall 2 | [![Travis build status](https://travis-ci.org/r-lib/pkginstall.svg?branch=master)](https://travis-ci.org/r-lib/pkginstall) 3 | [![Coverage status](https://codecov.io/gh/r-lib/pkginstall/branch/master/graph/badge.svg)](https://codecov.io/github/r-lib/pkginstall?branch=master) 4 | [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/r-lib/pkginstall?branch=master&svg=true)](https://ci.appveyor.com/project/r-lib/pkginstall) 5 | [![Lifecycle: superseded](https://img.shields.io/badge/lifecycle-superseded-orange.svg)](https://www.tidyverse.org/lifecycle/#superseded) 6 | 7 | 8 |

9 | 10 |

11 | 12 | Provides a replacement for `utils::install.packages(repo = NULL)`. 13 | I.e. it builds binary packages from source packages, and extracts the 14 | compressed archives into the package library. 15 | 16 | Compared to `utils::install.packages()` it 17 | 18 | - Has robust support for installing packages in parallel. 19 | - Fails immediately when the first package fails when installing multiple packages, rather than returning a warning. 20 | - Uses the same code paths on all platforms, rather than similar (but not identical) code paths. 21 | - Succeeds or fails atomically. Either the complete package is installed or it fails with an informative error message. 22 | - Has additional tests for package validity before installing 23 | - Always uses per-package lock files, to protect against simultaneous installation 24 | - Has a robust set of tests, to ensure correctness and ease debugging installation issues. 25 | 26 | ## Installation 27 | 28 | Once on CRAN, install with 29 | 30 | ```r 31 | install.packages("pkginstall") 32 | ``` 33 | 34 | ## Example 35 | 36 | ``` r 37 | files <- download.packages("remotes", type = "binary", ".") 38 | pkginstall::install_binary(files[[2]]) 39 | ``` 40 | 41 | ## Status [![Lifecycle: superseded](https://img.shields.io/badge/lifecycle-superseded-orange.svg)](https://www.tidyverse.org/lifecycle/#superseded) 42 | 43 | pkginstall is superseded: the functionality was included directly in the pkgdepends package, used by pak. We recommend using [pak](https://github.com/r-lib/pak) instead. 44 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | 10 | install: 11 | ps: Bootstrap 12 | 13 | cache: 14 | - C:\RLibrary 15 | 16 | # Adapt as necessary starting from here 17 | 18 | environment: 19 | GITHUB_PAT: 20 | secure: Nkvazgyo9FBXlhdY1vdqGsSNJl/DjKXhBYRFd105iEpZxKAXWI5X1aQ/awLgCfWa 21 | NOT_CRAN: true 22 | USE_RTOOLS: true 23 | 24 | build_script: 25 | - travis-tool.sh install_deps 26 | 27 | test_script: 28 | - travis-tool.sh run_tests 29 | 30 | on_failure: 31 | - 7z a failure.zip *.Rcheck\* 32 | - appveyor PushArtifact failure.zip 33 | 34 | artifacts: 35 | - path: '*.Rcheck\**\*.log' 36 | name: Logs 37 | 38 | - path: '*.Rcheck\**\*.out' 39 | name: Logs 40 | 41 | - path: '*.Rcheck\**\*.fail' 42 | name: Logs 43 | 44 | - path: '*.Rcheck\**\*.Rout' 45 | name: Logs 46 | 47 | - path: '\*_*.tar.gz' 48 | name: Bits 49 | 50 | - path: '\*_*.zip' 51 | name: Bits 52 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: 10 | default: 11 | target: auto 12 | threshold: 1% 13 | -------------------------------------------------------------------------------- /inst/tools/pkg_1.0.0.tgz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/pkg_1.0.0.tgz -------------------------------------------------------------------------------- /inst/tools/xxx: -------------------------------------------------------------------------------- 1 | xxx 2 | -------------------------------------------------------------------------------- /inst/tools/xxx.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/xxx.bz2 -------------------------------------------------------------------------------- /inst/tools/xxx.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/xxx.gz -------------------------------------------------------------------------------- /inst/tools/xxx.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/xxx.tar.gz -------------------------------------------------------------------------------- /inst/tools/xxx.xz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/xxx.xz -------------------------------------------------------------------------------- /inst/tools/xxx.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/inst/tools/xxx.zip -------------------------------------------------------------------------------- /man/install_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install_binary.R 3 | \name{install_binary} 4 | \alias{install_binary} 5 | \title{Install a R binary package} 6 | \usage{ 7 | install_binary(filename, lib = .libPaths()[[1L]], metadata = NULL, 8 | quiet = NULL) 9 | } 10 | \arguments{ 11 | \item{filename}{filename of built binary package to install} 12 | 13 | \item{lib}{library to install packages into} 14 | 15 | \item{metadata}{Named character vector of metadata entries to be added 16 | to the \code{DESCRIPTION} after installation.} 17 | 18 | \item{quiet}{Whether to suppress console output.} 19 | } 20 | \description{ 21 | Install a R binary package 22 | } 23 | -------------------------------------------------------------------------------- /man/install_package_plan.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/install.R 3 | \name{install_package_plan} 4 | \alias{install_package_plan} 5 | \title{Perform a package installation plan, as created by pkgdepends} 6 | \usage{ 7 | install_package_plan(plan, lib = .libPaths()[[1]], num_workers = 1) 8 | } 9 | \arguments{ 10 | \item{plan}{Package plan object, returned by pkgdepends} 11 | 12 | \item{lib}{Library directory to install to.} 13 | 14 | \item{num_workers}{Number of worker processes to use.} 15 | } 16 | \value{ 17 | Information about the installation process. 18 | } 19 | \description{ 20 | Perform a package installation plan, as created by pkgdepends 21 | } 22 | -------------------------------------------------------------------------------- /man/make_untar_process.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tar.R 3 | \name{make_untar_process} 4 | \alias{make_untar_process} 5 | \title{Create a tar background process} 6 | \usage{ 7 | make_untar_process(tarfile, files = NULL, exdir = ".", 8 | restore_times = TRUE, post_process = NULL) 9 | } 10 | \arguments{ 11 | \item{tarfile}{Tar file.} 12 | 13 | \item{files}{Files or regular expressions to set what to extract. if 14 | \code{NULL} then everything is extracted.} 15 | 16 | \item{exdir}{Where to extract the archive. It must exist.} 17 | 18 | \item{restore_times}{Whether to restore file modification times.} 19 | 20 | \item{post_process}{Function to call after the extraction.} 21 | } 22 | \value{ 23 | The \link[callr:process]{callr::process} object. 24 | } 25 | \description{ 26 | Use an external tar program, if there is a working one, otherwise use 27 | the internal implementation. 28 | } 29 | \details{ 30 | When using the internal implementation, we need to start another R 31 | process. 32 | } 33 | \keyword{internal} 34 | -------------------------------------------------------------------------------- /man/need_internal_tar.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tar.R 3 | \name{need_internal_tar} 4 | \alias{need_internal_tar} 5 | \title{Check if we need to use R's internal tar implementation} 6 | \usage{ 7 | need_internal_tar() 8 | } 9 | \value{ 10 | Whether we need to use the internal tar implementation. 11 | } 12 | \description{ 13 | This is slow, because we need to start an R child process, and the 14 | implementation is also very slow. So it is better to use an extranl tar 15 | program, if we can. We test this by trying to uncompress a .tar.gz 16 | archive using the external program. The name of the tar program is 17 | taken from the \code{TAR} environment variable, if this is unset then \code{tar} 18 | is used. 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/pkginstall-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pkginstall.R 3 | \docType{package} 4 | \name{pkginstall-package} 5 | \alias{pkginstall} 6 | \alias{pkginstall-package} 7 | \title{Intall Packages from Local Files} 8 | \description{ 9 | Provides a replacement for \code{utils::install.packages(repo = NULL)}. 10 | I.e. it builds binary packages from source packages, and extracts the 11 | compressed archives into the package library. 12 | } 13 | \section{Features}{ 14 | 15 | 16 | Compared to \code{utils::install.packages()} it 17 | \itemize{ 18 | \item Has robust support for installing packages in parallel. 19 | \item Fails immediately when the first package fails when installing 20 | multiple packages, rather than returning a warning. 21 | \item Uses the same code paths on all platforms, rather than similar (but 22 | not identical) code paths. 23 | \item Succeeds or fails atomically. Either the complete package is installed 24 | or it fails with an informative error message. 25 | \item Has additional tests for package validity before installing 26 | \item Always uses per-package lock files, to protect against simultaneous 27 | installation. 28 | \item Has a robust set of tests, to ensure correctness and ease debugging 29 | installation issues. 30 | } 31 | } 32 | 33 | \section{Locking}{ 34 | 35 | 36 | pkginstall uses the \code{install.lock} option. If this is set to \code{FALSE}, 37 | then no locking is performed. For all other values (including if the 38 | option is unset or is \code{NULL}), per-package lock files are used, via the 39 | filelock package. 40 | } 41 | 42 | \author{ 43 | \strong{Maintainer}: Jim Hester \email{james.f.hester@gmail.com} 44 | 45 | Authors: 46 | \itemize{ 47 | \item Gábor Gábor \email{csardi.gabor@gmail.com} 48 | } 49 | 50 | } 51 | -------------------------------------------------------------------------------- /pkginstall.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(pkginstall) 3 | 4 | test_check("pkginstall", reporter = "summary") 5 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad1/file1: -------------------------------------------------------------------------------- 1 | file1 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad1/file2: -------------------------------------------------------------------------------- 1 | file2 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad2/bad2/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Not really a valid DESCRIPTION file 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad2/bad2/Meta/package.rds: -------------------------------------------------------------------------------- 1 | meta 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad3/bad3/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Version: 1.0.0 2 | Maintainer: Bugs Bunny 3 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad3/bad3/Meta/package.rds: -------------------------------------------------------------------------------- 1 | meta 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad4/bad4/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: anotherpackage 2 | Version: 1.0.0 3 | Maintainer: Bugs Bunny 4 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/packages/bad4/bad4/Meta/package.rds: -------------------------------------------------------------------------------- 1 | meta 2 | -------------------------------------------------------------------------------- /tests/testthat/fixtures/sample_plan.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/pkginstall/e9e87810619c484797e8ff79e0337cb57bf3d95a/tests/testthat/fixtures/sample_plan.rds -------------------------------------------------------------------------------- /tests/testthat/foo/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: foo 2 | Version: 0.0.0.9000 3 | Title: What the Package Does (one line, title case) 4 | Description: What the package does (one paragraph). 5 | Authors@R: person("Jim", "Hester", email = "james.f.hester@gmail.com", role = c("aut", "cre")) 6 | License: GPL-3 7 | Encoding: UTF-8 8 | LazyData: true 9 | ByteCompile: true 10 | RoxygenNote: 6.0.1 11 | -------------------------------------------------------------------------------- /tests/testthat/foo/NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(foo) 4 | useDynLib(foo,foo_) 5 | -------------------------------------------------------------------------------- /tests/testthat/foo/R/foo.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib foo foo_ 2 | #' @export 3 | foo <- function() { 4 | .Call(foo_) 5 | } 6 | 7 | .onUnload <- function(libpath) { 8 | library.dynam.unload("foo", libpath) 9 | } 10 | -------------------------------------------------------------------------------- /tests/testthat/foo/src/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include // for NULL 5 | 6 | /* .Call calls */ 7 | extern SEXP foo_(); 8 | 9 | static const R_CallMethodDef CallEntries[] = {{"foo_", (DL_FUNC)&foo_, 0}, 10 | {NULL, NULL, 0}}; 11 | 12 | void R_init_foo(DllInfo *dll) { 13 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 14 | R_useDynamicSymbols(dll, FALSE); 15 | } 16 | 17 | SEXP foo_() { 18 | return R_NilValue; 19 | } 20 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | local_binary_package <- function(pkgname, ..., envir = parent.frame()) { 2 | 3 | # All arguments must be named 4 | args <- list(...) 5 | stopifnot(length(args) == 0 || rlang::is_named(args)) 6 | 7 | d <- create_temp_dir() 8 | pkgdir <- file.path(d, pkgname) 9 | dir.create(pkgdir) 10 | nms <- names(args) 11 | for (i in seq_along(args)) { 12 | dir.create(file.path(pkgdir, dirname(nms[[i]])), showWarnings = FALSE, recursive = TRUE) 13 | withr::with_connection(list(con = file(file.path(pkgdir, nms[[i]]), open = "wb")), { 14 | writeLines(args[[i]], con, sep = "\n") 15 | }) 16 | } 17 | 18 | filename <- file.path(d, glue("{pkgname}.tgz")) 19 | withr::with_dir( 20 | dirname(filename), 21 | utils::tar(basename(filename), pkgname, compression = "gzip") 22 | ) 23 | 24 | # We do not want to unlink files if we are calling this from the R console, 25 | # useful when debugging. 26 | is_globalenv <- identical(envir, globalenv()) 27 | if (!is_globalenv) { 28 | withr::defer(unlink(d, recursive = TRUE), envir = envir) 29 | } 30 | filename 31 | } 32 | 33 | binary_test_package <- function(name) { 34 | 35 | binary <- switch(sysname(), 36 | windows = glue("{name}.zip"), 37 | linux = glue("{name}_R_x86_64-pc-linux-gnu.tar.gz"), 38 | mac = glue("{name}.tgz"), 39 | skip(glue("Cannot test on {sysname()}")) 40 | ) 41 | if (!file.exists(binary)) { 42 | pkgbuild::build(sub("_.*$", "", name), binary = TRUE, quiet = TRUE) 43 | } 44 | binary 45 | } 46 | 47 | expect_error_free <- function(...) { 48 | testthat::expect_error(..., regexp = NA) 49 | } 50 | 51 | if (is_loaded("foo")) { 52 | unloadNamespace("foo") 53 | } 54 | 55 | #' @importFrom callr r_process r_process_options 56 | 57 | dummy_worker_process <- R6::R6Class( 58 | "dummy_worker_process", 59 | inherit = callr::r_process, 60 | public = list( 61 | initialize = function(...) { 62 | super$initialize(...) 63 | }, 64 | get_built_file = function() NA_character_ 65 | ) 66 | ) 67 | 68 | make_dummy_worker_process <- function(n_iter = 10, sleep = 1, status = 0) { 69 | n_iter; sleep; status 70 | function(...) { 71 | dummy_worker_process$new(r_process_options( 72 | func = function(n_iter, sleep, status) { 73 | # nocov start 74 | for (i in seq_len(n_iter)) { 75 | cat("out ", i, "\n", sep = "") 76 | message("err ", i) 77 | Sys.sleep(sleep) 78 | } 79 | status 80 | .GlobalEnv$.Last <- function() { 81 | rm(list = ".Last", envir = .GlobalEnv) 82 | quit(save = "no", status = status) 83 | } 84 | # nocov end 85 | }, 86 | args = list(n_iter = n_iter, sleep = sleep, status = status) 87 | )) 88 | } 89 | } 90 | 91 | skip_without_package <- function(pkg) { 92 | if (!requireNamespace(pkg, quietly = TRUE)) skip(paste("No", pkg)) 93 | } 94 | 95 | make_install_plan <- function(ref, lib = .libPaths()[1]) { 96 | r <- asNamespace("pkgdepends")$remotes()$new(ref, lib = lib) 97 | r$resolve() 98 | r$solve() 99 | r$download_solution() 100 | r$get_install_plan() 101 | } 102 | -------------------------------------------------------------------------------- /tests/testthat/test-install-binary.R: -------------------------------------------------------------------------------- 1 | context("install_binary") 2 | 3 | test_that("install_binary", { 4 | 5 | pkg <- binary_test_package("foo_0.0.0.9000") 6 | 7 | libpath <- create_temp_dir() 8 | on.exit({ 9 | detach("package:foo", character.only = TRUE, unload = TRUE) 10 | remove.packages("foo", lib = libpath) 11 | unlink(libpath, recursive = TRUE) 12 | }) 13 | 14 | expect_error_free( 15 | install_binary(pkg, lib = libpath, quiet = TRUE)) 16 | expect_error_free( 17 | library("foo", lib.loc = libpath)) 18 | expect_equal(foo::foo(), NULL) 19 | }) 20 | 21 | test_that("install_binary works for simultaneous installs", { 22 | skip_on_cran() 23 | 24 | pkg <- binary_test_package("foo_0.0.0.9000") 25 | on.exit({ 26 | detach("package:foo", character.only = TRUE, unload = TRUE) 27 | remove.packages("foo", lib = libpath) 28 | unlink(libpath, recursive = TRUE) 29 | }) 30 | 31 | libpath <- create_temp_dir() 32 | 33 | processes <- list() 34 | num <- 5 35 | 36 | # install and load foo here to test loaded DLLs in another process 37 | expect_error_free( 38 | install_binary(pkg, lib = libpath, quiet = TRUE)) 39 | expect_error_free( 40 | library("foo", lib.loc = libpath)) 41 | 42 | expect_equal(foo::foo(), NULL) 43 | processes <- replicate(num, simplify = FALSE, 44 | callr::r_bg(args = list(pkg, libpath), 45 | function(pkg, libpath) pkginstall::install_binary(pkg, lib = libpath)) 46 | ) 47 | 48 | repeat { 49 | Sys.sleep(.1) 50 | done <- all(!map_lgl(processes, function(x) x$is_alive())) 51 | if (done) { break } 52 | } 53 | 54 | for (i in seq_len(num)) { 55 | expect_identical(processes[[i]]$get_result(), file.path(libpath, "foo")) 56 | } 57 | }) 58 | 59 | test_that("install_binary errors", { 60 | tmp <- tempfile() 61 | on.exit(unlink(tmp), add = TRUE) 62 | cat("foobar\n", file = tmp) 63 | 64 | expect_error( 65 | install_binary(tmp, lib = tempdir(), quiet = TRUE), 66 | "unknown archive type", class = "invalid_input" 67 | ) 68 | }) 69 | 70 | test_that("make_install_process error", { 71 | tmp <- tempfile() 72 | on.exit(unlink(tmp), add = TRUE) 73 | cat("foobar\n", file = tmp) 74 | 75 | expect_error( 76 | make_install_process(tmp, lib = tempdir()), 77 | "Cannot extract", class = "invalid_input" 78 | ) 79 | }) 80 | -------------------------------------------------------------------------------- /tests/testthat/test-install-parts.R: -------------------------------------------------------------------------------- 1 | 2 | context("install parts") 3 | 4 | test_that("make_start_state", { 5 | plan <- readRDS("fixtures/sample_plan.rds") 6 | state <- make_start_state(plan, list(foo = "bar")) 7 | 8 | expect_equal(names(state), c("plan", "workers", "config")) 9 | xcols <- c( 10 | "build_done", "build_time", "build_error", "build_stdout", 11 | "build_stderr", "install_done", "install_time", "install_error", 12 | "install_stdout", "install_stderr") 13 | expect_true(all(xcols %in% colnames(state$plan))) 14 | eq_cols <- setdiff(colnames(plan), "deps_left") 15 | expect_identical( 16 | as.data.frame(plan[, eq_cols]), 17 | as.data.frame(state$plan[, eq_cols]) 18 | ) 19 | }) 20 | 21 | test_that("are_we_done", { 22 | plan <- readRDS("fixtures/sample_plan.rds") 23 | state <- make_start_state(plan, list(foo = "bar")) 24 | expect_false(are_we_done(state)) 25 | 26 | state$plan$install_done <- TRUE 27 | state$plan$install_done[1] <- FALSE 28 | expect_false(are_we_done(state)) 29 | 30 | state$plan$install_done[1] <- TRUE 31 | expect_true(are_we_done(state)) 32 | }) 33 | 34 | test_that("poll_workers", { 35 | state <- list(workers = list()) 36 | expect_equal(poll_workers(state), logical()) 37 | 38 | skip_on_os("windows") 39 | 40 | ## These might fail, but that does not matter much here 41 | p1 <- callr::process$new("true", stdout = "|") 42 | p2 <- callr::process$new("true", stdout = "|") 43 | 44 | state <- list(workers = list(list(process = p1))) 45 | expect_equal(poll_workers(state), TRUE) 46 | 47 | state <- list(workers = c(state$workers, list(list(process = p2)))) 48 | expect_true(any(poll_workers(state))) 49 | 50 | opts <- callr::r_process_options(func = function() Sys.sleep(5)) 51 | p3 <- callr::r_process$new(opts) 52 | on.exit(p3$kill(), add = TRUE) 53 | state <- list(workers = c(state$workers, list(list(process = p3)))) 54 | p <- poll_workers(state) 55 | expect_true(any(p)) 56 | expect_false(p[3]) 57 | p3$kill() 58 | }) 59 | 60 | test_that("handle_event, process still running", { 61 | ## If just output, but the process is still running, then collect 62 | ## stdout and stderr 63 | plan <- readRDS("fixtures/sample_plan.rds") 64 | state <- make_start_state(plan, list(num_workers = 2)) 65 | 66 | mockery::stub( 67 | start_task_build, "make_build_process", 68 | make_dummy_worker_process()) 69 | 70 | ## Run a dummy worker that runs for 10s, writes to stdout & stderr 71 | withr::local_options(list(pkg.show_progress = FALSE)) 72 | 73 | state <- start_task_build(state, task("build", pkgidx = 1)) 74 | proc <- state$workers[[1]]$process 75 | on.exit(proc$kill(), add = TRUE) 76 | 77 | for (i in 1:2) { 78 | proc$poll_io(-1) 79 | state <- handle_event(state, 1) 80 | expect_false(is.null(state$workers[[1]])) 81 | ## We cannot be sure that both stdout and stderr are already there, 82 | ## but one of them must be 83 | expect_true( 84 | any(grepl("^out ", state$workers[[1]]$stdout)) || 85 | any(grepl("^err ", state$workers[[1]]$stderr))) 86 | expect_true(proc$is_alive()) 87 | expect_false(is.na(state$plan$worker_id[1])) 88 | } 89 | 90 | proc$kill() 91 | }) 92 | 93 | test_that("handle_event, build process finished", { 94 | plan <- readRDS("fixtures/sample_plan.rds") 95 | state <- make_start_state(plan, list(foo = "bar")) 96 | state$plan$build_done[1] <- FALSE 97 | 98 | mockery::stub( 99 | start_task_build, "make_build_process", 100 | make_dummy_worker_process(n_iter = 2, sleep = 0)) 101 | 102 | withr::local_options(list(pkg.show_progress = FALSE)) 103 | 104 | state <- start_task_build(state, task("build", pkgidx = 1)) 105 | 106 | proc <- state$workers[[1]]$process 107 | on.exit(proc$kill(), add = TRUE) 108 | 109 | repeat { 110 | events <- poll_workers(state) 111 | state <- handle_events(state, events) 112 | if (all(state$plan$build_done)) break; 113 | } 114 | 115 | expect_false(proc$is_alive()) 116 | expect_false(state$plan$build_error[[1]]) 117 | expect_equal(state$plan$build_stdout[[1]], c("out 1", "out 2")) 118 | expect_equal(state$plan$build_stderr[[1]], c("err 1", "err 2")) 119 | expect_identical(state$plan$worker_id[[1]], NA_character_) 120 | expect_equal(length(state$workers), 0) 121 | }) 122 | 123 | test_that("handle event, build process finished, but failed", { 124 | plan <- readRDS("fixtures/sample_plan.rds") 125 | state <- make_start_state(plan, list(foo = "bar")) 126 | state$plan$build_done[1] <- FALSE 127 | 128 | mockery::stub( 129 | start_task_install, "make_install_process", 130 | make_dummy_worker_process(n_iter = 2, sleep = 0, status = 1)) 131 | 132 | withr::local_options(list(pkg.show_progress = FALSE)) 133 | 134 | state <- start_task_install(state, task("install", pkgidx = 1)) 135 | proc <- state$workers[[1]]$process 136 | on.exit(proc$kill(), add = TRUE) 137 | 138 | expect_error( 139 | repeat { 140 | events <- poll_workers(state) 141 | state <- handle_events(state, events) 142 | if (all(state$plan$build_done)) break; 143 | }, 144 | "Failed to install" 145 | ) 146 | 147 | }) 148 | 149 | test_that("handle_event, install process finished", { 150 | plan <- readRDS("fixtures/sample_plan.rds") 151 | state <- make_start_state(plan, list(foo = "bar")) 152 | 153 | mockery::stub( 154 | start_task_install, "make_install_process", 155 | make_dummy_worker_process(n_iter = 2, sleep = 0)) 156 | 157 | withr::local_options(list(pkg.show_progress = FALSE)) 158 | 159 | state <- start_task_install(state, task("install", pkgidx = 1)) 160 | proc <- state$workers[[1]]$process 161 | on.exit(proc$kill(), add = TRUE) 162 | 163 | done <- FALSE 164 | repeat { 165 | events <- poll_workers(state) 166 | state <- handle_events(state, events) 167 | if (done) break 168 | if (!proc$is_alive()) done <- TRUE 169 | } 170 | 171 | expect_false(proc$is_alive()) 172 | expect_false(state$plan$install_error[[1]]) 173 | expect_equal(state$plan$install_stdout[[1]], c("out 1", "out 2")) 174 | expect_equal(state$plan$install_stderr[[1]], c("err 1", "err 2")) 175 | expect_identical(state$plan$worker_id[[1]], NA_character_) 176 | expect_equal(length(state$workers), 0) 177 | }) 178 | 179 | test_that("handle event, install process finished, but failed", { 180 | plan <- readRDS("fixtures/sample_plan.rds") 181 | state <- make_start_state(plan, list(foo = "bar")) 182 | 183 | mockery::stub( 184 | start_task_install, "make_install_process", 185 | make_dummy_worker_process(n_iter = 2, sleep = 0, status = 1)) 186 | 187 | withr::local_options(list(pkg.show_progress = FALSE)) 188 | 189 | state <- start_task_install(state, task("install", pkgidx = 1)) 190 | proc <- state$workers[[1]]$process 191 | on.exit(proc$kill(), add = TRUE) 192 | 193 | expect_error({ 194 | done <- FALSE 195 | repeat { 196 | events <- poll_workers(state) 197 | state <- handle_events(state, events) 198 | if (done) break 199 | if (!proc$is_alive()) done <- TRUE 200 | } 201 | }, "Failed to install") 202 | }) 203 | 204 | test_that("select_next_task", { 205 | plan <- readRDS("fixtures/sample_plan.rds") 206 | state <- make_start_state(plan, list(num_workers = 2)) 207 | 208 | ## If no more workers are available 209 | state$workers <- list(list("dummy1"), list("dummy2")) 210 | expect_equal(select_next_task(state), task("idle")) 211 | 212 | ## An ongoing install task is not selected again 213 | state <- make_start_state(plan, list(num_workers = 2)) 214 | state$plan$worker_id[-nrow(state$plan)] <- 42 215 | expect_equal( 216 | select_next_task(state), 217 | task("install", pkgidx = nrow(state$plan))) 218 | 219 | ## An ongoing build task is not selected again 220 | state <- make_start_state(plan, list(num_workers = 2)) 221 | state$plan$build_done <- FALSE 222 | state$plan$deps_left[] <- rep_list(nrow(state$plan), character()) 223 | state$plan$worker_id[-nrow(state$plan)] <- 42 224 | expect_equal( 225 | select_next_task(state), 226 | task("build", pkgidx = nrow(state$plan))) 227 | 228 | ## Source is preferred over binary 229 | state <- make_start_state(plan, list(num_workers = 2)) 230 | state$plan$build_done[nrow(state$plan)] <- FALSE 231 | state$plan$deps_left[] <- rep_list(nrow(state$plan), character()) 232 | expect_equal( 233 | select_next_task(state), 234 | task("build", pkgidx = nrow(state$plan))) 235 | 236 | ## Source is selected only if dependencies are done 237 | state <- make_start_state(plan, list(num_workers = 2)) 238 | state$plan$build_done <- FALSE 239 | state$plan$deps_left[] <- rep_list(nrow(state$plan), "foobar") 240 | state$plan$deps_left[[nrow(state$plan)]] <- character() 241 | expect_equal( 242 | select_next_task(state), 243 | task("build", pkgidx = nrow(state$plan))) 244 | 245 | ## Binary is selected irrespectively of dependencies 246 | state <- make_start_state(plan, list(num_workers = 2)) 247 | state$plan$deps_left[] <- rep_list(nrow(state$plan), "foobar") 248 | expect_equal( 249 | select_next_task(state), 250 | task("install", pkgidx = 1L)) 251 | 252 | ## We cannot select anything, because of the dependencies 253 | state <- make_start_state(plan, list(num_workers = 2)) 254 | state$plan$build_done <- FALSE 255 | state$plan$worker_id[1] <- 1 256 | state$plan$deps_left[] <- rep_list(nrow(state$plan), "foobar") 257 | expect_equal( 258 | select_next_task(state), 259 | task("idle")) 260 | }) 261 | 262 | test_that("start_task", { 263 | expect_error( 264 | start_task(list(), task("foobar")), 265 | "Unknown task" 266 | ) 267 | }) 268 | 269 | test_that("stop_task", { 270 | expect_error( 271 | stop_task(list(), list(task = task("foobar"))), 272 | "Unknown task" 273 | ) 274 | }) 275 | 276 | test_that("get_worker_id", { 277 | expect_true(get_worker_id() != get_worker_id()) 278 | }) 279 | 280 | test_that("kill_all_processes", { 281 | 282 | skip_on_os("windows") 283 | 284 | p1 <- callr::process$new("true", stdout = "|") 285 | on.exit(p1$kill(), add = TRUE) 286 | p2 <- callr::process$new("true", stdout = "|") 287 | on.exit(p2$kill(), add = TRUE) 288 | opts <- callr::r_process_options(func = function() Sys.sleep(5)) 289 | p3 <- callr::r_process$new(opts) 290 | on.exit(p3$kill(), add = TRUE) 291 | 292 | state <- list(workers = list( 293 | list(process = p1), 294 | list(process = p2), 295 | list(process = p3) 296 | )) 297 | 298 | kill_all_processes(state) 299 | 300 | expect_false(p1$is_alive()) 301 | expect_false(p2$is_alive()) 302 | expect_false(p3$is_alive()) 303 | 304 | p1$kill() 305 | p2$kill() 306 | p3$kill() 307 | }) 308 | 309 | test_that("kill_all_processes that catch/ignore SIGINT", { 310 | 311 | skip_on_cran() 312 | skip_on_os("windows") 313 | if (Sys.which("bash") == "") skip("Needs 'bash'") 314 | 315 | sh <- "trap '&>2 echo \"Hold on\"' INT 316 | for ((n=5; n; n--)) 317 | do 318 | echo going 319 | sleep 1 320 | done" 321 | 322 | px <- callr::process$new("bash", c("-c", sh), stdout = "|", stderr = "|") 323 | expect_true(px$is_alive()) 324 | 325 | state <- list(workers = list(list(process = px))) 326 | 327 | ## Need to wait until the shell starts and traps SIGINT 328 | px$poll_io(2000) 329 | 330 | tic <- Sys.time() 331 | kill_all_processes(state) 332 | expect_true(Sys.time() - tic > as.difftime(0.2, units = "secs")) 333 | expect_false(px$is_alive()) 334 | 335 | ## We can't get the output of the signal handler, because SIGKILL 336 | ## does not ensure emptying the buffers.... 337 | 338 | px$kill() 339 | }) 340 | -------------------------------------------------------------------------------- /tests/testthat/test-install.R: -------------------------------------------------------------------------------- 1 | 2 | context("install_packages") 3 | 4 | describe("install_packages", { 5 | 6 | skip_without_package("pkgdepends") 7 | 8 | it("works with source packages", { 9 | 10 | pkg <- "foo_0.0.0.9000.tar.gz" 11 | expect_error_free(pkgbuild::build("foo", quiet = TRUE)) 12 | 13 | libpath <- create_temp_dir() 14 | 15 | on.exit({ 16 | detach("package:foo", character.only = TRUE, unload = TRUE) 17 | remove.packages("foo", lib = libpath) 18 | unlink(libpath, recursive = TRUE) 19 | unlink(pkg) 20 | }) 21 | 22 | withr::with_options(list(pkg.show_progress = FALSE), { 23 | plan <- make_install_plan( 24 | paste0("local::", pkg), lib = libpath) 25 | expect_error_free( 26 | install_package_plan(plan, lib = libpath)) 27 | }) 28 | 29 | expect_error_free( 30 | library("foo", lib.loc = libpath)) 31 | }) 32 | }) 33 | -------------------------------------------------------------------------------- /tests/testthat/test-metadata.R: -------------------------------------------------------------------------------- 1 | 2 | context("metadata") 3 | 4 | test_that("install_binary metadata", { 5 | 6 | pkg <- binary_test_package("foo_0.0.0.9000") 7 | 8 | libpath <- create_temp_dir() 9 | on.exit(unlink(libpath, recursive = TRUE), add = TRUE) 10 | 11 | metadata <- c("Foo" = "Bar", "Foobar" = "baz") 12 | expect_error_free( 13 | install_binary(pkg, lib = libpath, metadata = metadata, quiet = TRUE)) 14 | 15 | dsc <- desc::desc(file.path(libpath, "foo")) 16 | expect_equal(dsc$get("Foo")[[1]], "Bar") 17 | expect_equal(dsc$get("Foobar")[[1]], "baz") 18 | 19 | rds <- readRDS(file.path(libpath, "foo", "Meta", "package.rds")) 20 | dsc2 <- rds$DESCRIPTION 21 | expect_equal(dsc2[["Foo"]], "Bar") 22 | expect_equal(dsc2[["Foobar"]], "baz") 23 | }) 24 | 25 | test_that("install_package_plan metadata", { 26 | 27 | skip_without_package("pkgdepends") 28 | 29 | pkg <- "foo_0.0.0.9000.tar.gz" 30 | expect_error_free(pkgbuild::build("foo", quiet = TRUE)) 31 | 32 | libpath <- create_temp_dir() 33 | on.exit(unlink(c(libpath, pkg), recursive = TRUE), add = TRUE) 34 | 35 | withr::with_options(list(pkg.show_progress = FALSE), { 36 | plan <- make_install_plan( 37 | paste0("local::", pkg), lib = libpath) 38 | plan$metadata[[1]] <- c("Foo" = "Bar", "Foobar" = "baz") 39 | plan$vignettes <- FALSE 40 | expect_error_free( 41 | install_package_plan(plan, lib = libpath, num_workers = 1) 42 | ) 43 | }) 44 | 45 | dsc <- desc::desc(file.path(libpath, "foo")) 46 | expect_equal(dsc$get("Foo")[[1]], "Bar") 47 | expect_equal(dsc$get("Foobar")[[1]], "baz") 48 | 49 | rds <- readRDS(file.path(libpath, "foo", "Meta", "package.rds")) 50 | dsc2 <- rds$DESCRIPTION 51 | expect_equal(dsc2[["Foo"]], "Bar") 52 | expect_equal(dsc2[["Foobar"]], "baz") 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test-paths.R: -------------------------------------------------------------------------------- 1 | 2 | context("non-trivial paths") 3 | 4 | test_that("folders with potentially problematic characters", { 5 | 6 | skip_on_cran() 7 | 8 | tmp <- tempfile() 9 | on.exit(tryCatch(unloadNamespace("foo"), error = identity), add = TRUE) 10 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 11 | on.exit(environment(need_internal_tar)$internal <- NULL, add = TRUE) 12 | 13 | pkg <- binary_test_package("foo_0.0.0.9000") 14 | 15 | folders <- c( 16 | "s p a c e s", 17 | enc2native("\u00fa\u00e1\u00f6\u0151\u00e9"), 18 | "s' p' a' c' e' s'" 19 | ) 20 | 21 | skipped <- 0 22 | 23 | for (f in folders) { 24 | error <- FALSE 25 | tryCatch( 26 | { 27 | if ("foo" %in% loadedNamespaces()) unloadNamespace("foo") 28 | unlink(tmp, recursive = TRUE) 29 | dir.create(tmp) 30 | dir.create(file.path(tmp, f)) 31 | libdir <- dir(tmp) 32 | libpath <- file.path(tmp, libdir) 33 | }, 34 | warning = function(e) error <<- TRUE, 35 | error = function(e) error <<- TRUE 36 | ) 37 | if (error) { skipped <- skipped + 1; next } 38 | 39 | ## Reset this 40 | environment(need_internal_tar)$internal <- NULL 41 | 42 | expect_error_free(install_binary(pkg, lib = libpath, quiet = TRUE)) 43 | expect_error_free(library("foo", lib.loc = libpath)) 44 | expect_equal(foo::foo(), NULL) 45 | unloadNamespace("foo") 46 | 47 | ## Make sure tar is internal 48 | unlink(tmp, recursive = TRUE) 49 | dir.create(tmp) 50 | dir.create(libpath) 51 | environment(need_internal_tar)$internal <- NULL 52 | withr::with_envvar(c(TAR = NA), 53 | withr::with_path("foobar", action = "replace", { 54 | expect_error_free(install_binary(pkg, lib = libpath, quiet = TRUE)) 55 | }) 56 | ) 57 | 58 | expect_error_free(library("foo", lib.loc = libpath)) 59 | expect_equal(foo::foo(), NULL) 60 | unloadNamespace("foo") 61 | } 62 | 63 | if (skipped) skip(paste(skipped, " path tests were skipped")) 64 | }) 65 | -------------------------------------------------------------------------------- /tests/testthat/test-tar.R: -------------------------------------------------------------------------------- 1 | 2 | context("tar") 3 | 4 | test_that("is_gzip, is_bzip2, is_xz, iz_zip", { 5 | 6 | cases <- list( 7 | list("is_gzip", "xxx.gz", 3), 8 | list("is_bzip2", "xxx.bz2", 3), 9 | list("is_xz", "xxx.xz", 6), 10 | list("is_zip", "xxx.zip", 4) 11 | ) 12 | 13 | lapply(cases, function(case) { 14 | fun <- get(case[[1]]) 15 | arch <- system.file(package = .packageName, "tools", case[[2]]) 16 | expect_true(fun(arch)) 17 | 18 | buf <- readBin(arch, what = "raw", n = case[[3]]) 19 | expect_true(fun(buf)) 20 | expect_false(fun(utils::head(buf, -1))) 21 | 22 | others <- setdiff(c("is_gzip", "is_bzip2", "is_xz", "is_zip"), case[[1]]) 23 | for (ofun in others) { 24 | expect_false(get(ofun)(arch)) 25 | expect_false(get(ofun)(buf)) 26 | } 27 | }) 28 | }) 29 | 30 | test_that("detect_package_archive_type", { 31 | 32 | cases <- list( 33 | list("gzip", "xxx.gz"), 34 | list("bzip2", "xxx.bz2"), 35 | list("xz", "xxx.xz"), 36 | list("zip", "xxx.zip"), 37 | list("unknown", "xxx") 38 | ) 39 | 40 | lapply(cases, function(case) { 41 | arch <- system.file(package = .packageName, "tools", case[[2]]) 42 | expect_equal(detect_package_archive_type(arch), case[[1]]) 43 | }) 44 | }) 45 | 46 | test_that("get_untar_decompress_arg", { 47 | cases <- list( 48 | list("-z", "xxx.gz"), 49 | list("-j", "xxx.bz2"), 50 | list("-J", "xxx.xz"), 51 | list(character(), "xxx") 52 | ) 53 | 54 | lapply(cases, function(case) { 55 | arch <- system.file(package = .packageName, "tools", case[[2]]) 56 | expect_identical(get_untar_decompress_arg(arch), case[[1]]) 57 | }) 58 | 59 | zip <- system.file(package = .packageName, "tools", "xxx.zip") 60 | expect_error(get_untar_decompress_arg(zip), "zip file") 61 | }) 62 | 63 | test_that("eup_get_args", { 64 | 65 | opts <- list( 66 | tarfile = system.file(package = .packageName, "tools", "pkg_1.0.0.tgz"), 67 | files = NULL, 68 | exdir = "exdir", 69 | restore_times = TRUE, 70 | tar = "tar" 71 | ) 72 | 73 | expect_equal( 74 | eup_get_args(opts), 75 | c("-x", "-f", opts$tarfile, "-C", opts$exdir, "-z") 76 | ) 77 | 78 | ## No need to ungzip 79 | opts$tarfile <- system.file(package = .packageName, "tools", "xxx") 80 | expect_equal( 81 | eup_get_args(opts), 82 | c("-x", "-f", opts$tarfile, "-C", opts$exdir) 83 | ) 84 | 85 | ## Files are specified 86 | opts$files <- c("this", "that") 87 | expect_equal( 88 | eup_get_args(opts), 89 | c("-x", "-f", opts$tarfile, "-C", opts$exdir, opts$files) 90 | ) 91 | 92 | ## Do not restore times 93 | opts$restore_times <- FALSE 94 | expect_equal( 95 | eup_get_args(opts), 96 | c("-x", "-f", opts$tarfile, "-C", opts$exdir, "-m", opts$files) 97 | ) 98 | }) 99 | 100 | test_that("external_untar_process", { 101 | 102 | if (need_internal_tar()) skip("external R does not work") 103 | 104 | tarfile <- system.file(package = .packageName, "tools", "pkg_1.0.0.tgz") 105 | mkdirp(tmp <- tempfile()) 106 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 107 | 108 | px <- external_untar_process$new(tarfile, exdir = tmp) 109 | px$wait(5000) 110 | px$kill() 111 | 112 | expect_equal(px$get_exit_status(), 0) 113 | expect_true(file.exists(file.path(tmp, "pkg", "DESCRIPTION"))) 114 | }) 115 | 116 | test_that("r_untar_process", { 117 | 118 | tarfile <- system.file(package = .packageName, "tools", "pkg_1.0.0.tgz") 119 | mkdirp(tmp <- tempfile()) 120 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 121 | 122 | px <- r_untar_process$new(tarfile, exdir = tmp) 123 | px$wait(5000) 124 | px$kill() 125 | 126 | expect_equal(px$get_exit_status(), 0) 127 | expect_true(file.exists(file.path(tmp, "pkg", "DESCRIPTION"))) 128 | }) 129 | 130 | test_that("make_untar_process", { 131 | 132 | tarfile <- system.file(package = .packageName, "tools", "pkg_1.0.0.tgz") 133 | mkdirp(tmp <- tempfile()) 134 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 135 | 136 | px <- make_untar_process(tarfile, exdir = tmp) 137 | px$wait(5000) 138 | px$kill() 139 | 140 | expect_equal(px$get_exit_status(), 0) 141 | expect_true(file.exists(file.path(tmp, "pkg", "DESCRIPTION"))) 142 | }) 143 | 144 | test_that("make_untar_process, internal tar", { 145 | 146 | mockery::stub(make_untar_process, "need_internal_tar", TRUE) 147 | 148 | tarfile <- system.file(package = .packageName, "tools", "pkg_1.0.0.tgz") 149 | mkdirp(tmp <- tempfile()) 150 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 151 | 152 | px <- make_untar_process(tarfile, exdir = tmp) 153 | px$wait(5000) 154 | px$kill() 155 | 156 | expect_equal(px$get_exit_status(), 0) 157 | expect_true(file.exists(file.path(tmp, "pkg", "DESCRIPTION"))) 158 | }) 159 | -------------------------------------------------------------------------------- /tests/testthat/test-utils.R: -------------------------------------------------------------------------------- 1 | 2 | context("utils") 3 | 4 | test_that("warn", { 5 | foo <- "bar" 6 | expect_warning( 7 | warn("this is {foo}"), 8 | "this is 'bar'" 9 | ) 10 | }) 11 | -------------------------------------------------------------------------------- /tests/testthat/test-verify-extracted-package.R: -------------------------------------------------------------------------------- 1 | context("verify_extracted_package") 2 | 3 | describe("verify_extracted_package", { 4 | 5 | tmp <- tempfile() 6 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 7 | run <- function(pkgfile) { 8 | unlink(tmp, recursive = TRUE) 9 | mkdirp(tmp) 10 | utils::untar(pkgfile, exdir = tmp) 11 | verify_extracted_package(pkgfile, tmp) 12 | } 13 | 14 | it("errors if archive doesn't contain a DESCRIPTION file", { 15 | f1 <- local_binary_package("test1") 16 | expect_error(run(f1), 17 | "'.*test1[.]tgz' is not a valid R package, it is an empty archive", 18 | class = "invalid_input") 19 | }) 20 | 21 | it("errors if archive DESCRIPTION is not in the root directory", { 22 | f2 <- local_binary_package("test2", "foo/DESCRIPTION" = character()) 23 | expect_error(run(f2), 24 | "'.*test2[.]tgz' is not a valid binary, it does not contain 'test2/Meta/package.rds' and 'test2/DESCRIPTION'.", 25 | class = "invalid_input") 26 | }) 27 | 28 | it("can handle multiple DESCRIPTION files", { 29 | f3 <- local_binary_package("test3", 30 | "DESCRIPTION" = c("Package: test3", "Built: 2017-01-01"), 31 | "tests/testthat/DESCRIPTION" = character(), 32 | "Meta/package.rds" = character()) 33 | expect_is(run(f3)$desc, "description") 34 | 35 | f4 <- local_binary_package("test4", 36 | "pkgdir/DESCRIPTION" = c("Package: test4", "Built: 2017-01-01"), 37 | "Meta/package.rds" = character()) 38 | expect_error(run(f4), 39 | "'.*test4[.]tgz' is not a valid binary, it does not contain 'test4/DESCRIPTION'.", 40 | class = "invalid_input") 41 | }) 42 | 43 | it("fails if the binary does not contain package.rds", { 44 | f5 <- local_binary_package("test5", "DESCRIPTION" = character()) 45 | expect_error(run(f5), 46 | "'.*test5[.]tgz' is not a valid binary, it does not contain 'test5/Meta/package[.]rds'", 47 | class = "invalid_input") 48 | }) 49 | 50 | it("fails if the DESCRIPTION file is empty", { 51 | f6 <- local_binary_package("test6", "DESCRIPTION" = character(), "Meta/package.rds" = character()) 52 | expect_error(run(f6), 53 | "'.*test6[.]tgz' is not a valid binary, 'test6/DESCRIPTION' is empty", 54 | class = "invalid_input") 55 | }) 56 | 57 | it("fails if the DESCRIPTION file has no 'Built' entry", { 58 | f7 <- local_binary_package("test7", "DESCRIPTION" = c("Package: test7"), "Meta/package.rds" = character()) 59 | expect_error(run(f7), 60 | "'.*test7[.]tgz' is not a valid binary, no 'Built' entry in 'test7/DESCRIPTION'", 61 | class = "invalid_input") 62 | }) 63 | }) 64 | 65 | test_that("verify_extrancted_package errors", { 66 | 67 | pkg_dir <- file.path("fixtures", "packages") 68 | 69 | expect_error( 70 | verify_extracted_package("bad1", file.path(pkg_dir, "bad1")), 71 | "single directory", class = "invalid_input") 72 | 73 | expect_error( 74 | verify_extracted_package("bad2", file.path(pkg_dir, "bad2")), 75 | "invalid", class = "invalid_input") 76 | 77 | expect_error( 78 | verify_extracted_package("bad3", file.path(pkg_dir, "bad3")), 79 | "Package", class = "invalid_input") 80 | 81 | expect_error( 82 | verify_extracted_package("bad4", file.path(pkg_dir, "bad4")), 83 | "package name mismatch", class = "invalid_input") 84 | }) 85 | -------------------------------------------------------------------------------- /tests/testthat/test-zip.R: -------------------------------------------------------------------------------- 1 | 2 | context("zip") 3 | 4 | test_that("make_unzip_process", { 5 | 6 | zipfile <- system.file(package = .packageName, "tools", "xxx.zip") 7 | mkdirp(tmp <- tempfile()) 8 | on.exit(unlink(tmp, recursive = TRUE), add = TRUE) 9 | 10 | px <- make_unzip_process(zipfile, exdir = tmp) 11 | px$wait(5000) 12 | px$kill() 13 | 14 | expect_equal(px$get_exit_status(), 0) 15 | expect_true(file.exists(file.path(tmp, "xxx"))) 16 | }) 17 | --------------------------------------------------------------------------------