#!/usr/local/bin/scsh -s
!#

;;; untar -- safely unpack a tarfile into a single directory
;; Written by Luke Gorrie <luke@bluetail.com> May 28 2000
;; untar <filename>
;; Unpacks a gzip'd tar file into the current directory, ensuring
;; that the contents all unpack into a single directory.

;; TODO: Worry about directory name collisions.
;;       Handle other files and tar flags (.tar, .tar.bz2, etc)

;; Runs in SCSH (Scheme Shell) http://www-swiss.ai.mit.edu/ftpdir/scsh/

(define main
  (lambda ()
    (if (not (= 2 (length (command-line))))
        (begin (format #t "Bad command line: ~A ~%" (command-line))
               (format #t "Usage: ~A <filename> ~%" (argv 0))
               (exit 1)))

    (let ((temp-dir (gen-temp-file-name))
          (tarfile (argv 1)))
      
      ;; remove the temporary directory, if it exists
      (define cleanup
        (lambda ()
          (if (file-exists? temp-dir)
              (run (rm -rf ,temp-dir)))))
      
      ;; cleanup on SIGINT
      (set-interrupt-handler (signal->interrupt signal/int)
                             (lambda (n)
                               (cleanup)
                               (exit 1)))
      
      ;; make temp dir and unpack into it
      (create-directory temp-dir)
      (run (tar zxf ,tarfile --directory ,temp-dir))

      (cond
       ;; unpacked nicely into one directory
       ((the-directory-inside temp-dir)
        => (lambda (dir)
             (let ((target-dir (last (split-file-name dir))))
               (run (mv ,dir ,target-dir))
               (format #t "Unpacked neatly into ~A~%" target-dir))))
       ;; unpacked in a mess!
       (else
        (let ((target-dir (neat-dirname (last (split-file-name tarfile)))))
          (run (mv ,temp-dir ,target-dir))
          (format #t "Unpacked messily into ~A~%" target-dir))))

      ;; nuke temp dir
      (cleanup))))

;; Generate a unique temporary filename in the current directory.
;; cwd is used instead of /tmp so that we don't have to move between
;; filesystems
(define gen-temp-file-name
  (lambda ()
    (define find-unused-filename
      (lambda (n)
        (let ((name (format #f "untar.~A.~A" (pid) n)))
          (if (file-exists? name)
              (try-file-name (n + 1))
              name))))
    (find-unused-filename 0)))

;; the directory that the file will unpack into if it's being "neat"
(define (neat-dirname file)
  (let* ((regexp (rx (: (| ".tar" ".tar.gz" ".tgz") eos)))
         (match (string-match regexp file)))
    (if match
        (substring file 0 (match:start match 0))
        file)))

;; Iff `dir' contains one directory and no files, returns the name of
;; the directory, else returns #f
(define (the-directory-inside dir)
  (let ((contents (directory-files dir)))
    (if (= 1 (length contents))
        (let ((item (string-append dir "/" (car contents))))
          (if (file-directory? item)
              item
              #f))
        #f)))

;; Do the business
(main)