scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Handle all options of id 

part of darcs patch Thu Sep 22 14:50:23 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 16:33:39 +00:00
parent 85a258237c
commit 16fa9cb6ad
2 changed files with 34 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/nuit-packages.scm
View File

@ -181,7 +181,7 @@
define-record-types define-record-types
(subset primitives (record-ref record?)) (subset primitives (record-ref record?))
(subset srfi-13 (string-join)) (subset srfi-13 (string-join))
(subset srfi-1 (partition)) (subset srfi-1 (partition lset-difference))
srfi-37 srfi-37
dirlist-view-plugin dirlist-view-plugin

42
scheme/user-group-info.scm
View File

@ -70,7 +70,13 @@
(receive (options args) (partition pair? given-args) (receive (options args) (partition pair? given-args)
(values (map car options) args))))) (values (map car options) args)))))
;;;usage: id [user]
;;; id -G [-n] [user]
;;; id -M
;;; id -P [user]
;;; id -g [-nr] [user]
;;; id -p [user]
;;; id -u [-nr] [user]
(define (id command args) (define (id command args)
(receive (options others) (parse-id-arguments args) (receive (options others) (parse-id-arguments args)
(let ((maybe-username (if (null? others) (let ((maybe-username (if (null? others)
@ -83,14 +89,25 @@
((and (member 'passwd options) ((and (member 'passwd options)
(= no-options 1)) (= no-options 1))
(run-passwd-id maybe-username)) (run-passwd-id maybe-username))
((member 'gid options) ((and (member 'gid options)
"-g option not supported yet") (null? (lset-difference
((member 'human-readable options) eq?
"-p option not supported yet") options
((member 'uid options) '(gid real name-instead))))
"-u option not supported yet") (run-uid/gid-id options args))
((and (member 'uid options)
(null? (lset-difference
eq?
options
'(uid real name-instead))))
(run-uid/gid-id options args))
((and (member 'human-readable options)
(= no-options 1))
(run-human-readable-id maybe-username))
(else (else
"illegal aruments for id" args))))) (string-append
"illegal arguments for id " (string-join args)))))))
(define (run-standard-id maybe-username) (define (run-standard-id maybe-username)
(let* ((out (run/string (id ,@ maybe-username))) (let* ((out (run/string (id ,@ maybe-username)))
@ -108,7 +125,14 @@
(let* ((out (run/string (id -P ,@ maybe-username)))) (let* ((out (run/string (id -P ,@ maybe-username))))
out)) out))
(define (run-uid/gid-id options args)
(let ((out (run/strings (id ,@args))))
(if (member 'name-instead options)
(car out)
(string->number (car out)))))
(define (run-human-readable-id maybe-username)
(run/string (id -p ,@ maybe-username)))
(register-plugin! (register-plugin!
(make-command-plugin (make-command-plugin