(define (wheel-write name args)
  (let ((allow_su (plistq 'allow_su args)))
    (and (pair? allow_su)
         (woo-try (if (cdr allow_su) "new" "delete")
                  (string-append "/local_groups/wheel/" name)))))

(define (groups-write name args)
  (for-each (lambda(group)
              (woo "new" (string-append "/local_groups/" group) 'type "system");;ignore error
              (woo-new (string-append "/local_groups/" group "/" name)))
            '("cdwriter" "cdrom" "audio" "proc" "radio" "camera" "floppy" "xgrp" "scanner")))

(define (cdr-or-null x)
  (if (pair? x) (cdr x) '()))

(object
 #f
 ;;constraints
 ((constraints self objects options)
  (let ((_ (make-translator "alterator-users" (cond-plistq 'language options '())))
        (is-new (string=? (cond-plistq 'orig_action options "") "new")))
    `(name (required
            ,is-new
            ,@(if is-new
                 `(match ("^[a-z_][a-z0-9_-]*$" ,(_"only small latin letters, digits and '_' allowed")))
                 '())
            label
            ,(_ "Name"))
           shell    (label ,(_ "Shell"))
           home     (label ,(_ "Home directory"))
           allow_su (default #f label ,(_ "Allow switching to superuser"))
           passwd1  (required ,is-new equal passwd2 label ,(_ "Password"))
           passwd2  (required ,is-new label ,(_ "Password (repeat)"))
           gecos    (default "" label ,(_ "Gecos")))))
 ;;list users
 ((list self objects options)
  (let ((wheels (woo-list-names "/local_groups/wheel")))
    (map (lambda(x)
           (let ((name (woo-get-option x 'name "no-name")))
             (cons* name
                    'allow_su (->bool (member name wheels))
                    (cdr x))))
         (woo-list (cons "local_users" objects)))))
 
 ;;read user
 ((read self objects options)
  (and (null? objects) (woo-throw "user name is not defined"))
  (cons*
   'allow_su (->bool (member (car objects) (woo-list-names "/local_groups/wheel")))
   (cdr-or-null (woo-read-first (cons "local_users" objects)))))
 ;;modify user
 ((write self objects options)
  (apply woo-write (cons "local_users" objects) options)
  (or (string=? (car objects) "root") (wheel-write (car objects) options))
  '())
 ;;delete user
 ((delete self objects options)
  (apply woo-delete (cons "local_users" objects) options)
  '())
 ;;create user
 ((new self objects options)
  (let ((name (cond-plistq 'name options "")))
    (apply woo-new (list "local_users" name) options)
    (groups-write name options)
    (wheel-write name options)
  '())))
