Parsing of id options, support for id -P

part of darcs patch Sat Sep 17 18:05:43 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/nuit-packages.scm

@@ -10,7 +10,8 @@
 
 (define-interface utils-interface
   (export display-to-string
-          write-to-string))
+          write-to-string
+          on/off-option-processor))
 
 (define-structure utils utils-interface
   (open scheme
@@ -163,7 +164,9 @@
         define-record-types
         (subset primitives (record-ref record?))
         (subset srfi-13 (string-join))
-
+        (subset srfi-1 (partition))
+        srfi-37
+        
         dirlist-view-plugin
         fs-object
         plugin

scheme/user-group-info.scm

@@ -36,12 +36,64 @@
                     l))))
      '() s)))
 
+(define (parse-id-arguments args)
+  (let ((gids-option
+         (option '(#\G) #f #f
+                 (on/off-option-processor 'gids)))
+        (passwd-option
+         (option '(#\P) #f #f 
+                 (on/off-option-processor 'passwd)))
+        (gid-option
+         (option '(#\g) #f #f 
+                 (on/off-option-processor 'gid)))
+        (name-instead-option
+         (option '(#\n) #f #f
+                 (on/off-option-processor 'name-instead)))
+        (human-readable-option
+         (option '(#\p) #f #f 
+                 (on/off-option-processor 'human-readable)))
+        (real-option 
+         (option '(#\r) #f #f 
+                 (on/off-option-processor 'real)))
+        (uid-option
+         (option '(#\u) #f #f 
+                 (on/off-option-processor 'uid))))
+    (let ((given-args
+	   (args-fold
+	    args
+	    (list gids-option passwd-option gid-option
+                  name-instead-option human-readable-option
+                  real-option uid-option)
+	    (lambda (option name args operands)
+	      (error "Unknown id option" name))
+	    cons '())))
+      (receive (options args) (partition pair? given-args)
+        (values (map car options) args)))))
+
+
 (define (id command args)
-  ;; TODO parse command line arguments
+  (receive (options others) (parse-id-arguments args)
-  (let* ((maybe-username (if (null? args)
+    (let ((maybe-username (if (null? others)
-                             '()
+                              '()
-                             args))
+                              others))
-         (out (run/string (id ,@ maybe-username)))
+          (no-options (length options)))
+      (cond 
+       ((null? options)
+        (run-standard-id maybe-username))
+       ((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")
+       (else
+        "illegal aruments for id" args)))))
+
+(define (run-standard-id maybe-username)
+  (let* ((out (run/string (id ,@ maybe-username)))
          (match (regexp-search id-regexp out)))
     (if match
         (make-id-output
@@ -52,6 +104,12 @@
          (parse-group-list (match:substring match 5)))
         'cannot-parse)))
 
+(define (run-passwd-id maybe-username)
+  (let* ((out (run/string (id -P ,@ maybe-username))))
+    out))
+         
+         
+
 (register-plugin!
  (make-command-plugin
   "id"