Mk Afs Dir
makeafsdir -- mkdir with default permissions for AFS
#!/home/gasbichl/i386_fbsd40/bin/scsh \
-e main -s
!#
(define (main args)
(call-with-values (lambda ()
((getopt '("p" . 0)
'("v" . 0)
'("m" . 1))
(cdr args)))
(lambda (opts args)
(set! options opts)
(set! arguments args)))
(let ((mkdiropts (options-for-mkdir options))
(umask (afs-umask)))
(for-each (lambda (dir)
(let ((newdirs (if (assoc "p" options)
(non-existing-dirs-in-path dir)
(list dir))))
(if (zero? (run (/bin/mkdir ,@mkdiropts ,dir)))
(for-each
(lambda (dir)
(let ((clear (let ((cleared? #f))
(lambda ()
(if cleared?
'()
(begin (set! cleared? #t)
'(-clear)))))))
(for-each
(lambda (user-perm)
(let ((c (clear)))
(run (,(fs) sa ,dir
,(car user-perm)
,(cadr user-perm) ,@c))))
umask)))
newdirs))))
arguments)
(flush-all-ports)))
(define (afs-umask)
(let ((var (getenv "AFSUMASK")))
(if var
(let ((user=perms ((infix-splitter (rx "|")) var)))
(map (lambda (user=perm)
(if (not (= (length user=perm) 2))
(error "invalid entry in AFSUMASK" user=perm)
user=perm))
(map (infix-splitter (rx "=")) user=perms)))
'())))
(define (non-existing-dirs-in-path path)
(let ((subdirs ((infix-splitter (rx "/") #f 'concat) (directory-as-file-name path))))
(let loop ((subdirs subdirs) (prefix ""))
(if (null? subdirs)
'()
(let ((with-prefix (string-append prefix (car subdirs))))
(if (file-exists? with-prefix)
(loop (cdr subdirs) with-prefix)
(car
(fold (lambda (dir prefix)
(cons (cons (string-append (cdr prefix) dir) (car prefix))
(string-append (cdr prefix) dir)))
(cons (list with-prefix) with-prefix)
(cdr subdirs)))))))))
(define (options-for-mkdir options)
(let ((mkdir-options '()))
(if (assoc "v" options)
(set! mkdir-options (cons "-v" mkdir-options)))
(if (assoc "p" options)
(set! mkdir-options (cons "-p" mkdir-options)))
(if (assoc "m" options)
(set! mkdir-options (cons (string-append "-m" (cdr (assoc "m" options)))
mkdir-options)))
mkdir-options))
(define getopt
(let ((option-sans-argument (make-regexp "^--([^=]+)$"))
(option-with-argument (make-regexp "^--([^=]+)=(.*)$"))
(short-option-with-more (make-regexp "^-([a-z])(.+)$"))
(short-option-sans-more (make-regexp "^-([a-z])$"))
(unknown-option-error
(lambda (option)
(format (error-output-port)
"unknown option `~A'~%try `~A -help'~%"
option (car (command-line)))
(exit 1)))
(missing-argument-error
(lambda (option)
(format (error-output-port)
"option `~A' requires an argument~%try `~A -help'~%"
option (car (command-line)))
(exit 1)))
(superfluous-argument-error
(lambda (option)
(format (error-output-port)
"option `~A' doesn't take an argument~%try `~A -help'~%"
option (car (command-line)))
(exit 1))))
(lambda option-specifiers
(lambda (args)
(let loop ((options '()) (rest args))
(if (null? rest)
(values options '())
(let ((first (car rest)))
(cond
((string=? "-" first) (values options (cdr rest)))
((regexp-exec option-sans-argument first) =>
(lambda (match)
(let* ((option (match:substring match 1))
(foo (assoc option option-specifiers)))
(cond
((not foo)
(unknown-option-error option))
((eq? #t (cdr foo))
(missing-argument-error option))
(else
(loop `((,option . #f) . ,options) (cdr rest)))))))
((regexp-exec option-with-argument first) =>
(lambda (match)
(let* ((option (match:substring match 1))
(foo (assoc option option-specifiers)))
(cond
((not foo)
(unknown-option-error option))
((eq? #f (cdr foo))
(superfluous-argument-error option))
(else
(loop `((,option . ,(match:substring match 2))
. ,options) (cdr rest)))))))
((regexp-exec short-option-sans-more first) =>
(lambda (match)
(let* ((option (match:substring match 1))
(arg? (assoc option option-specifiers))
(arg? (if arg? (cdr arg?) arg?)))
(cond
((not arg?)
(unknown-option-error option))
((= arg? 1)
(if (null? (cdr rest))
(missing-argument-error option)
(loop `((,option . ,(cadr rest))
. ,options) (cddr rest))))
((= arg? 0)
(loop `((,option . #f)
. ,options) (cdr rest)))
(else (error "arg? ???" arg?))))))
((regexp-exec short-option-with-more first) =>
(lambda (match)
(let* ((option (match:substring match 1))
(arg? (assoc option option-specifiers))
(arg? (if arg? (cdr arg?) arg?)))
(cond
((not arg?)
(unknown-option-error option))
((= arg? 1)
(let ((rest-of-first (match:substring match 2)))
(loop `((,option . ,rest-of-first)
. ,options) (cdr rest))))
((= arg? 0)
(let ((rest-of-first (match:substring match 2)))
(loop `((,option . ,#f)
. ,options) (cons (string-append "-" rest-of-first)
(cdr rest)))))
(else (error "arg? ???" arg?))))))
(else
(values options rest))))))))))
(define options #f)
(define arguments #f)
(define (fs)
(if (string=? (run/string (uname)) "FreeBSD\n")
'/afs/wsi/i386_fbsd43/openafs-080401/bin/fs
'fs))>
MkAfsDir - raw wiki source |
code snippets archive
|
