Command plugin and viewer for id(1)

scheme/user-group-info.scm

@@ -1,5 +1,145 @@
 (define key-return 10)
 
+(define-record-type id-output :id-output
+  (make-id-output uid name gid group groups)
+  id-output?
+  (uid id-output-uid)
+  (name id-output-name)
+  (gid id-output-gid)
+  (group id-output-group)
+  (groups id-output-groups))
+
+(define id-regexp
+  (rx
+   (: "uid=" (submatch (+ digit))
+      "(" (submatch (+ alphabetic))
+      ") gid=" (submatch (+ digit))
+      "(" (submatch (+ alphabetic))
+      ") groups=" (submatch (* any)))))                        
+                                  
+(define (parse-group-list s)
+  (let ((gid-or-gid/name 
+         (rx (| (submatch (+ digit))
+                (: (submatch (+ digit))
+                   "("
+                   (submatch (+ alphabetic))
+                   ")")))))
+    (regexp-fold 
+     gid-or-gid/name
+     (lambda (start match l)
+       (cond ((match:substring match 1)
+              => (lambda (gid)
+                   (cons gid l)))
+             (else
+              (cons (cons (match:substring match 2)
+                          (match:substring match 3))
+                    l))))
+     '() s)))
+
+(define (id command args)
+  ;; TODO parse command line arguments
+  (let* ((maybe-username (if (null? args)
+                             '()
+                             args))
+         (out (run/string (id ,@ maybe-username)))
+         (match (regexp-search id-regexp out)))
+    (if match
+        (make-id-output
+         (match:substring match 1)
+         (match:substring match 2)
+         (match:substring match 3)
+         (match:substring match 4)
+         (parse-group-list (match:substring match 5)))
+        'cannot-parse)))
+
+(register-plugin!
+ (make-command-plugin
+  "id"
+  #f
+  id))
+
+(define (make-id-output-select-list ido num-lines)
+  (make-select-list
+   `(,(make-unmarked-element 
+       (cons 'user 
+             (string->number
+              (id-output-uid ido)))
+       #t
+       (string-append "UID: " (id-output-uid ido)))
+     ,(make-unmarked-element 
+       (cons 'user (id-output-name ido))
+       #t
+       (string-append "Name: " (id-output-name ido)))
+     ,(make-unmarked-element 
+       (cons 'group 
+             (string->number
+              (id-output-gid ido)))
+       #t
+       (string-append "GID: " (id-output-gid ido)))
+     ,(make-unmarked-element 
+       (cons 'group 
+             (id-output-group ido))
+       #t
+       (string-append "GID: " (id-output-group ido)))
+     ,(make-unmarked-element 
+       'text
+       #f
+       "Groups:")
+     ,@(map (lambda (group)
+              (let ((gid (if (pair? group)
+                             (car group)
+                             group))
+                    (gname (if (pair? group)
+                               (cdr group)
+                               "")))
+                (make-unmarked-element 
+                 (cons 'group (string->number gid))
+                 #t
+                 (string-append "  " gid " " gname))))
+            (id-output-groups ido)))
+   num-lines))
+
+(define (make-id-output-browser ido buffer)
+  (let ((ido ido)
+        (buffer buffer)
+        (selection-list
+         (make-id-output-select-list 
+          ido
+          (result-buffer-num-lines buffer))))
+    (lambda (message)
+      (case message
+        ((paint)
+         (lambda (self . args)
+           (apply paint-selection-list
+                  selection-list args)))
+        ((key-press)
+         (lambda (self key control-x-pressed?)
+           (cond
+            ((= key key-return)
+             (let ((selected 
+                    (select-list-selected-entry selection-list)))
+               (cond
+                ((and (pair? selected)
+                      (eq? (car selected) 'user))
+                 (make-user-info-browser 
+                  (user-info (cdr selected)) buffer))
+                ((and (pair? selected)
+                      (eq? (car selected) 'group))
+                 (make-group-info-browser 
+                  (group-info (cdr selected)) buffer))
+                (else self))))
+            (else
+             (set! selection-list
+                   (select-list-handle-key-press
+                    selection-list key))
+             self))))
+        (else
+         (error "unknown message in make-id-output-browser" 
+                message))))))
+
+(register-plugin!
+ (make-view-plugin make-id-output-browser id-output?))
+
 (define (make-gi-select-list gi num-lines)
   (make-select-list
    `(,(make-unmarked-element 'name