(use-modules (alterator pipe))

(define min_uid
  (with-input-from-file 
    "/etc/login.defs"
    (lambda ()
      (define min_var "UID_MIN")

      (let loop ((line (read-line)))
	(cond
	  ((eof-object? line) 0)
	  ((string-starts-with? line min_var)
	   (or (string->number
		 (substring line (string-skip line char-whitespace? (string-length min_var))
			    (string-length line)))
	       0))
	  (else (loop (read-line))))))))

(define (user-list)
  (with-input-from-file
    "/etc/passwd"
    (lambda ()
      (let loop ((line (read-line))
		 (res '()))
	(if (eof-object? line) res
	  (let* ((pos1 (string-index line #\:))
		 (pos2 (string-index line #\: (+ pos1 1)))
		 (pos3 (string-index line #\: (+ pos2 1)))
		 (name (substring line 0 pos1))
		 (uid (string->number (substring line (+ pos2 1) pos3))))
	    (if (>= uid min_uid)
	      (loop (read-line) (cons (list name) res))
	      (loop (read-line) res))))))))

(define (user-info username)
  (with-input-from-file
    "/etc/passwd"
    (lambda ()
      (let loop ((line (read-line)))
	(cond
	  ((eof-object? line) '(error "user not found"))
	  ((string-starts-with? line (string-append username ":"))
	   (let ((fields (string-splitting line #\: #t)))
	     `(uid ,(list-ref fields 2)
		   gid ,(list-ref fields 3)
		   gecos ,(list-ref fields 4)
		   home ,(list-ref fields 5)
		   shell ,(list-ref fields 6))))
	  (else (loop (read-line))))))))

(define (user-del username)
  (system (string-append "/usr/sbin/userdel " username)) #f)

(define (user-change command user . args)
  (define (change-passwd name password)
    (let ((process (create-process 'write-only "/usr/sbin/chpasswd")))
      (catch #t
	     (lambda()
	       (with-ignored-sigpipe
		 (lambda() (write-line (format #f "~A:~A" user password) (caddr process))))
	       (stop-process 'wait process))
	     (lambda (key . args) (stop-process 'terminate process)))))
  (let ((passwd (and (pair? args) and (assq 'passwd (car args))))
	(cmd-options
	  (or (and (pair? args)
		   (string-join (map (lambda (x)
				       (case (car x)
					 ((uid) (string-append "-u " (sure-string (cdr x))))
					 ((gid) (string-append "-g " (sure-string (cdr x))))
					 ((gecos) (string-append "-c \"" (cdr x) "\""))
					 ((home) (string-append "-d \"" (cdr x) "\""))
					 ((shell) (string-append "-s \"" (cdr x) "\""))
					 (else "")))
				     (car args))
				" "))
	      "")))
    (system (string-append command " " cmd-options " " user))
    (if passwd (change-passwd user (cdr passwd)))
    '()))

(define (user-exists name)
  (member name (user-list)))

;todo: added checking for existance for new and checking for 
(lambda (objects action)
  (case action
    ((list) (lambda args (user-list)))
    ((read) (lambda args (user-info (car objects))))
    ((write) (lambda args (apply user-change "/usr/sbin/usermod" (car objects) args)))
    ((new) (lambda args (and (not (user-exists (car objects)))
			     (apply user-change "/usr/sbin/useradd" (car objects) args))))
    ((delete) (lambda args (user-del (car objects))))
    (else (error-mariner "unsupported action for local_users backend"))))

