!! 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))>