123 lines
3.9 KiB
Scheme
Executable File
123 lines
3.9 KiB
Scheme
Executable File
#!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)
|