-
Notifications
You must be signed in to change notification settings - Fork 24
Expand file tree
/
Copy pathzip.R
More file actions
382 lines (361 loc) · 10.4 KB
/
zip.R
File metadata and controls
382 lines (361 loc) · 10.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
#' @useDynLib zip, .registration = TRUE, .fixes = "c_"
NULL
#' Compress Files into 'zip' Archives
#'
#' `zip()` creates a new zip archive file.
#'
#' `zip_append()` appends compressed files to an existing 'zip' file.
#'
#' ## Relative paths
#'
#' `zip()` and `zip_append()` can run in two different modes: mirror
#' mode and cherry picking mode. They handle the specified `files`
#' differently.
#'
#' ### Mirror mode
#'
#' Mirror mode is for creating the zip archive of a directory structure,
#' exactly as it is on the disk. The current working directory will
#' be the root of the archive, and the paths will be fully kept.
#' zip changes the current directory to `root` before creating the
#' archive.
#'
#' E.g. consider the following directory structure:
#'
#' ```{r echo = FALSE, comment = ""}
#' dir.create(tmp <- tempfile())
#' oldwd <- getwd()
#' setwd(tmp)
#' dir.create("foo/bar", recursive = TRUE)
#' dir.create("foo/bar2")
#' dir.create("foo2")
#' cat("this is file1", file = "foo/bar/file1")
#' cat("this is file2", file = "foo/bar/file2")
#' cat("this is file3", file = "foo2/file3")
#' out <- processx::run("tree", c("--noreport", "--charset=ascii"))
#' cat(crayon::strip_style(out$stdout))
#' setwd(oldwd)
#' ```
#'
#' Assuming the current working directory is `foo`, the following zip
#' entries are created by `zip`:
#' ```{r, echo = 2:4}
#' setwd(tmp)
#' setwd("foo")
#' zip::zip("../test.zip", c("bar/file1", "bar2", "../foo2"))
#' zip_list("../test.zip")[, "filename", drop = FALSE]
#' setwd(oldwd)
#' ```
#'
#' Note that zip refuses to store files with absolute paths, and chops
#' off the leading `/` character from these file names. This is because
#' only relative paths are allowed in zip files.
#'
#' ### Cherry picking mode
#'
#' In cherry picking mode, the selected files and directories
#' will be at the root of the archive. This mode is handy if you
#' want to select a subset of files and directories, possibly from
#' different paths and put all of the in the archive, at the top
#' level.
#'
#' Here is an example with the same directory structure as above:
#'
#' ```{r, echo = 3:4}
#' setwd(tmp)
#' setwd("foo")
#' zip::zip(
#' "../test2.zip",
#' c("bar/file1", "bar2", "../foo2"),
#' mode = "cherry-pick"
#')
#' zip_list("../test2.zip")[, "filename", drop = FALSE]
#' setwd(oldwd)
#' ```
#'
#' From zip version 2.3.0, `"."` has a special meaning in the `files`
#' argument: it will include the files (and possibly directories) within
#' the current working directory, but **not** the working directory itself.
#' Note that this only applies to cherry picking mode.
#'
#' ## Permissions:
#'
#' `zip()` (and `zip_append()`, etc.) add the permissions of
#' the archived files and directories to the ZIP archive, on Unix systems.
#' Most zip and unzip implementations support these, so they will be
#' recovered after extracting the archive.
#'
#' Note, however that the owner and group (uid and gid) are currently
#' omitted, even on Unix.
#'
#' ## `zipr()` and `zipr_append()`
#'
#' These function exist for historical reasons. They are identical
#' to `zip()` and `zipr_append()` with a different default for the
#' `mode` argument.
#'
#' @param zipfile The zip file to create. If the file exists, `zip`
#' overwrites it, but `zip_append` appends to it. If it is a directory
#' an error is thrown.
#' @param files List of file to add to the archive. See details below
#' about absolute and relative path names.
#' @param recurse Whether to add the contents of directories recursively.
#' @param compression_level A number between 1 and 9. 9 compresses best,
#' but it also takes the longest.
#' @param include_directories Whether to explicitly include directories
#' in the archive. Including directories might confuse MS Office when
#' reading docx files, so set this to `FALSE` for creating them.
#' @param root Change to this working directory before creating the
#' archive.
#' @param mode Selects how files and directories are stored in
#' the archive. It can be `"mirror"` or `"cherry-pick"`.
#' See "Relative Paths" below for details.
#' @return The name of the created zip file, invisibly.
#'
#' @export
#' @examples
#' ## Some files to zip up. We will run all this in the R session's
#' ## temporary directory, to avoid messing up the user's workspace.
#' dir.create(tmp <- tempfile())
#' dir.create(file.path(tmp, "mydir"))
#' cat("first file", file = file.path(tmp, "mydir", "file1"))
#' cat("second file", file = file.path(tmp, "mydir", "file2"))
#'
#' zipfile <- tempfile(fileext = ".zip")
#' zip::zip(zipfile, "mydir", root = tmp)
#'
#' ## List contents
#' zip_list(zipfile)
#'
#' ## Add another file
#' cat("third file", file = file.path(tmp, "mydir", "file3"))
#' zip_append(zipfile, file.path("mydir", "file3"), root = tmp)
#' zip_list(zipfile)
zip <- function(
zipfile,
files,
recurse = TRUE,
compression_level = 9,
include_directories = TRUE,
root = ".",
mode = c("mirror", "cherry-pick")
) {
mode <- match.arg(mode)
zip_internal(
zipfile,
files,
recurse,
compression_level,
append = FALSE,
root = root,
keep_path = (mode == "mirror"),
include_directories = include_directories
)
}
#' @rdname zip
#' @export
zipr <- function(
zipfile,
files,
recurse = TRUE,
compression_level = 9,
include_directories = TRUE,
root = ".",
mode = c("cherry-pick", "mirror")
) {
mode <- match.arg(mode)
zip_internal(
zipfile,
files,
recurse,
compression_level,
append = FALSE,
root = root,
keep_path = (mode == "mirror"),
include_directories = include_directories
)
}
#' @rdname zip
#' @export
zip_append <- function(
zipfile,
files,
recurse = TRUE,
compression_level = 9,
include_directories = TRUE,
root = ".",
mode = c("mirror", "cherry-pick")
) {
mode <- match.arg(mode)
zip_internal(
zipfile,
files,
recurse,
compression_level,
append = TRUE,
root = root,
keep_path = (mode == "mirror"),
include_directories = include_directories
)
}
#' @rdname zip
#' @export
zipr_append <- function(
zipfile,
files,
recurse = TRUE,
compression_level = 9,
include_directories = TRUE,
root = ".",
mode = c("cherry-pick", "mirror")
) {
mode <- match.arg(mode)
zip_internal(
zipfile,
files,
recurse,
compression_level,
append = TRUE,
root = root,
keep_path = (mode == "mirror"),
include_directories = include_directories
)
}
zip_internal <- function(
zipfile,
files,
recurse,
compression_level,
append,
root,
keep_path,
include_directories
) {
zipfile <- path.expand(zipfile)
if (dir.exists(zipfile)) {
stop("zip file at `", zipfile, "` already exists and it is a directory")
}
oldwd <- setwd(root)
on.exit(setwd(oldwd), add = TRUE)
if (!all(file.exists(files))) stop("Some files do not exist")
data <- get_zip_data(files, recurse, keep_path, include_directories)
data$key <- fix_absolute_paths(data$key)
warn_for_colon(data$key)
warn_for_dotdot(data$key)
.Call(
c_R_zip_zip,
enc2c(zipfile),
enc2c(data$key),
enc2c(data$file),
data$dir,
file.info(data$file)$mtime,
as.integer(compression_level),
append
)
invisible(zipfile)
}
#' List Files in a 'zip' Archive
#'
#' @details Note that `crc32` is formatted using `as.hexmode()`. `offset` refers
#' to the start of the local zip header for each entry. Following the approach
#' of `seek()` it is stored as a `numeric` rather than an `integer` vector and
#' can therefore represent values up to `2^53-1` (9 PB).
#' @param zipfile Path to an existing ZIP file.
#' @return A data frame with columns: `filename`, `compressed_size`,
#' `uncompressed_size`, `timestamp`, `permissions`, `crc32`, `offset` and
#' `type`. `type` is one of `file`, `block_device`, `character_device`,
#' `directory`, `FIFO`, `symlink` or `socket`.
#'
#' @family zip/unzip functions
#' @export
zip_list <- function(zipfile) {
zipfile <- enc2c(normalizePath(zipfile))
res <- .Call(c_R_zip_list, zipfile)
if (Sys.getenv("PKGCACHE_NO_PILLAR") == "") {
requireNamespace("pillar", quietly = TRUE)
}
df <- data_frame(
filename = res[[1]],
compressed_size = res[[2]],
uncompressed_size = res[[3]],
timestamp = as.POSIXct(res[[4]], tz = "UTC", origin = "1970-01-01")
)
Encoding(df$filename) <- "UTF-8"
df$permissions <- as.octmode(res[[5]])
df$crc32 <- as.hexmode(res[[6]])
df$offset <- res[[7]]
# names are the same as in `fs::file_info()`
df$type <- file_types[res[[8]] + 1L]
df
}
file_types <- c(
"file",
"block_device",
"character_device",
"directory",
"FIFO",
"symlink",
"socket"
)
#' Uncompress 'zip' Archives
#'
#' `unzip()` always restores modification times of the extracted files and
#' directories.
#'
#' @section Permissions:
#'
#' If the zip archive stores permissions and was created on Unix,
#' the permissions will be restored.
#'
#' @param zipfile Path to the zip file to uncompress.
#' @param files Character vector of files to extract from the archive.
#' Files within directories can be specified, but they must use a forward
#' slash as path separator, as this is what zip files use internally.
#' If `NULL`, all files will be extracted.
#' @param overwrite Whether to overwrite existing files. If `FALSE` and
#' a file already exists, then an error is thrown.
#' @param junkpaths Whether to ignore all directory paths when creating
#' files. If `TRUE`, all files will be created in `exdir`.
#' @param exdir Directory to uncompress the archive to. If it does not
#' exist, it will be created.
#'
#' @export
#' @examples
#' ## temporary directory, to avoid messing up the user's workspace.
#' dir.create(tmp <- tempfile())
#' dir.create(file.path(tmp, "mydir"))
#' cat("first file", file = file.path(tmp, "mydir", "file1"))
#' cat("second file", file = file.path(tmp, "mydir", "file2"))
#'
#' zipfile <- tempfile(fileext = ".zip")
#' zip::zip(zipfile, "mydir", root = tmp)
#'
#' ## List contents
#' zip_list(zipfile)
#'
#' ## Extract
#' tmp2 <- tempfile()
#' unzip(zipfile, exdir = tmp2)
#' dir(tmp2, recursive = TRUE)
unzip <- function(
zipfile,
files = NULL,
overwrite = TRUE,
junkpaths = FALSE,
exdir = "."
) {
stopifnot(
is_string(zipfile),
is_character_or_null(files),
is_flag(overwrite),
is_flag(junkpaths),
is_string(exdir)
)
zipfile <- enc2c(normalizePath(zipfile))
if (!is.null(files)) files <- enc2c(files)
exdir <- sub("/+$", "", exdir)
mkdirp(exdir)
exdir <- enc2c(normalizePath(exdir))
.Call(c_R_zip_unzip, zipfile, files, overwrite, junkpaths, exdir)
invisible()
}