From 005061d7127f2decef800b10d2836748327ef7c4 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 3 Nov 2018 18:39:52 +0100 Subject: [PATCH] tar: Support -C. * gash/commands/tar.scm (tar): Support -C. --- gash/commands/tar.scm | 9 ++++++++- gash/ustar.scm | 3 ++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/gash/commands/tar.scm b/gash/commands/tar.scm index 2790b9d..fff6a8c 100644 --- a/gash/commands/tar.scm +++ b/gash/commands/tar.scm @@ -37,6 +37,7 @@ (let* ((option-spec '((create (single-char #\c)) (compress (single-char #\Z)) + (directory (single-char #\C) (value #t)) (gzip (single-char #\z)) (bzip2 (single-char #\j)) (xz (single-char #\J)) @@ -82,6 +83,7 @@ ((string-suffix? ".gz" file) 'gzip) ((string-suffix? ".xz" file) 'xz) (else #f)))))) + (directory (option-ref options 'directory #f)) (sort-order (and=> (option-ref options 'sort #f) string->symbol)) (strip (string->number (or (option-ref options 'strip #f) @@ -91,11 +93,16 @@ (usage? (and (not help?) (not (or (and create? (pair? files)) extract? list?)))) (verbosity (length (multi-opt options 'verbose))) - (version? (option-ref options 'version #f))) + (version? (option-ref options 'version #f)) + (file (if (or (not directory) (string-prefix? "/" file) (equal? file "-")) file + (string-append (getcwd) "/" file)))) + (when directory + (chdir directory)) (cond (version? (format #t "tar (GASH) ~a\n" %version) (exit 0)) ((or help? usage?) (format (if usage? (current-error-port) #t) "\ Usage: tar [OPTION]... [FILE]... + -C, --directory=DIR change to directory DIR -c, --create create a new archive -f, --file=ARCHIVE use archive file or device ARCHIVE --group=NAME force NAME as group for added files diff --git a/gash/ustar.scm b/gash/ustar.scm index a6285ba..e08086d 100644 --- a/gash/ustar.scm +++ b/gash/ustar.scm @@ -465,6 +465,7 @@ (file-name (if (zero? strip) file-name (string-join (list-tail (string-split file-name #\/) strip) "/"))) (dir (dirname file-name)) + (extract? (and extract? (not (string-null? file-name)))) (thunk (lambda _ (let loop ((read 0)) (and (< read size) @@ -515,7 +516,7 @@ #:group group #:mtime mtime #:numeric-owner? numeric-owner? #:owner owner #:sort-order sort-order #:verbosity verbosity) files)) -(define* (write-ustar-archive file-name files #:key group mtime numeric-owner? owner verbosity) +(define* (write-ustar-archive file-name files #:key group mtime numeric-owner? owner sort-order verbosity) (catch #t (lambda _ (call-with-port* (open-file file-name "wb")