123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123 |
- #!guile \
- --no-auto-compile -s
- !#
- ;; This is an example Guix containerization wrapper.
- (use-modules (srfi srfi-1)
- (ice-9 receive))
- (define program-command "unrar")
- (define program-package "unrar")
- (define empty-dir "/tmp/empty")
- (define user "foo")
- (define (usage)
- (display
- (format #f "Usage: ~a COMMAND [OPTIONS] ARCHIVE [FILES...]
- [@LISTFILES...] [OUTPUT-DIR/]
- Run program in a container. Within the container, the archive is read-only and
- the OUTPUT-DIR is shared read-write.
- OUTPUT-DIR must end with a '/'. If unspecified, current directory is used.
- See below for the original program options:
- "
- (first (command-line))))
- (let ((command-line `("guix" "environment"
- "--pure"
- ,(string-append "--user=" user)
- "--container"
- "--ad-hoc" program-package
- "--"
- program-command "h")))
- (run-command-line command-line)))
- (define (parse-args)
- (let ((args (command-line))
- (command "")
- (switches '())
- (archive "")
- (files '())
- (output-directory (getcwd)))
- ;; Skip caller.
- (set! args (cdr args))
- ;; Check for help.
- (when (and (not (null? args))
- (or (string=? (first args) "-h")
- (string=? (first args) "--help")))
- (usage)
- (exit #t))
- ;; Command.
- (unless (null? args)
- (set! command (first args))
- (set! args (cdr args)))
- ;; Switches.
- (while (and (not (null? args))
- (string=? (string-take (first args) 1) "-"))
- (set! switches (append (list (first args)) files))
- (set! args (cdr args)))
- (set! switches (reverse! switches))
- ;; Archive.
- (unless (null? args)
- (set! archive (first args))
- (set! args (cdr args)))
- ;; Files and filelists.
- (while (and (not (null? args))
- (not (string=? (string-take-right (first args) 1) "/")))
- (set! files (append (list (first args)) files))
- (set! args (cdr args)))
- (set! files (reverse! files))
- ;; Output dir.
- (unless (null? args)
- (set! output-directory (first args))
- (set! args (cdr args)))
- ;; Handy error checking while we are at it.
- (unless (null? args)
- (warn "Possible extraneous arguments:" args))
- (values command switches archive files output-directory)))
- (define (expose file)
- (string-append "--expose=" file "=" (basename file)))
- (define (run-command-line command-line)
- ;; TODO: Use guix' mkdir-p?
- (unless (file-exists? empty-dir)
- (mkdir empty-dir))
- (apply system* command-line)
- (rmdir empty-dir))
- (define (main)
- (receive (command switches archive files output-directory)
- (parse-args)
- (when (or (string=? command "")
- (string=? archive ""))
- (display "Both COMMAND and ARCHIVE arguments are required")
- (newline)
- (usage)
- (exit #f))
- (let ((command-line `("guix" "environment"
- "--pure"
- ,(string-append "--user=" user)
- "--container"
- ,(expose archive)
- ,@(map expose files)
- ,(string-append "--share=" output-directory "=" (basename output-directory))
- "--ad-hoc" program-package
- "--"
- program-command
- ,command
- ,@switches
- ,(basename archive)
- ,@(map basename files)
- ;; TODO: This is not the right
- ,(string-append (basename output-directory) "/")
- )))
- (display (format #f "Running command: ~a" command-line))
- (newline)
- (newline)
- (run-command-line command-line))))
- (main)
|