diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index a4e1ebf..780f687 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -181,7 +181,7 @@ define-record-types (subset primitives (record-ref record?)) (subset srfi-13 (string-join)) - (subset srfi-1 (partition)) + (subset srfi-1 (partition lset-difference)) srfi-37 dirlist-view-plugin diff --git a/scheme/user-group-info.scm b/scheme/user-group-info.scm index 3cd5123..e12099d 100644 --- a/scheme/user-group-info.scm +++ b/scheme/user-group-info.scm @@ -70,7 +70,13 @@ (receive (options args) (partition pair? given-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) (receive (options others) (parse-id-arguments args) (let ((maybe-username (if (null? others) @@ -83,14 +89,25 @@ ((and (member 'passwd options) (= no-options 1)) (run-passwd-id maybe-username)) - ((member 'gid options) - "-g option not supported yet") - ((member 'human-readable options) - "-p option not supported yet") - ((member 'uid options) - "-u option not supported yet") + ((and (member 'gid options) + (null? (lset-difference + eq? + options + '(gid real name-instead)))) + (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 - "illegal aruments for id" args))))) + (string-append + "illegal arguments for id " (string-join args))))))) + (define (run-standard-id maybe-username) (let* ((out (run/string (id ,@ maybe-username))) @@ -108,7 +125,14 @@ (let* ((out (run/string (id -P ,@ maybe-username)))) 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! (make-command-plugin