thodg/cl-unix-cybernetics

diff --git a/adams.asd b/adams.asd
index 391f660..afdb555 100644
--- a/adams.asd
+++ b/adams.asd
@@ -68,5 +68,6 @@
 	     (:file "operations" :depends-on ("commands" "defs"))
 	     (:file "probes"  :depends-on ("commands" "defs"
                                            "stat" "syntaxes"))
+             (:file "ssh" :depends-on ("defs"))
 	     (:file "stat")
 	     (:file "syntaxes")))))
diff --git a/package.lisp b/package.lisp
index bfcfb82..4c586e8 100644
--- a/package.lisp
+++ b/package.lisp
@@ -139,6 +139,7 @@
    #:parse-stat<1>
    #:passwd<5>
    #:process
+   #:ssh-authorized-key
    #:stat
    #:stat<1>
    #:+timestamp-offset+
diff --git a/unix/ssh.lisp b/unix/ssh.lisp
new file mode 100644
index 0000000..5de8c8d
--- /dev/null
+++ b/unix/ssh.lisp
@@ -0,0 +1,81 @@
+;;
+;;  adams  -  Remote system administration tools
+;;
+;;  Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :adams)
+
+(in-re-readtable)
+
+(define-resource-class ssh-authorized-key ()
+  ()
+  ((probe-ssh-authorized-key :properties (:ensure :name :pubkey :type)))
+  ((op-ssh-authorized-key :properties (:ensure :name :pubkey :type))))
+
+(define-syntax ssh-public-key (type pubkey name)
+    #~|([^\s]+)\s+([^\s]+)\s+(.*)|)
+
+(defun ssh-authorized-key (key)
+  (multiple-value-bind (type pubkey name) (parse-ssh-public-key key)
+    (resource 'ssh-authorized-key name
+              :type type
+              :pubkey pubkey
+              :name name)))
+
+(defmethod probe-ssh-authorized-key ((res ssh-authorized-key)
+                                     (os os-unix))
+  (let* ((spec-type (the string (specified-property res :type)))
+         (spec-pubkey (the string (specified-property res :pubkey)))
+         (user *parent-resource*)
+         (home (resource-id (get-probed user :home)))
+         (path (str home "/.ssh/authorized_keys"))
+         (file (with-parent-resource *host*
+                 (resource 'file path)))
+         (ensure :absent))
+    (multiple-value-bind (type pubkey name)
+        (unless (eq :absent (get-probed file :ensure))
+          (with-ssh-public-key (type pubkey name)
+              (run "cat " (sh-quote path))
+            (when (and (string= spec-type (the string type))
+                       (string= spec-pubkey (the string pubkey)))
+              (setq ensure :present)
+              (return (values type pubkey name)))))
+      (properties* ensure type pubkey name))))
+
+(defmethod op-ssh-authorized-key ((res ssh-authorized-key)
+                                  (os os-unix)
+                                  &key ensure type pubkey name)
+  (declare (type symbol ensure))
+  (let* ((user *parent-resource*)
+         (home (resource-id (get-probed user :home)))
+         (dot-ssh (str home "/.ssh"))
+         (ak (str dot-ssh "/authorized_keys"))
+         (sh-ak (sh-quote ak))
+         (sh-ak-tmp (sh-quote (str ak ".tmp"))))
+    (setf type (specified-property res :type)
+          pubkey (specified-property res :pubkey)
+          name (specified-property res :name))
+    (with-parent-resource *host*
+      (sync (resource 'directory dot-ssh :ensure :present
+                      :mode #o700))
+      (sync (resource 'file ak :ensure :present :mode #o600)))
+    (format t "~&ensure ~S~%" ensure)
+    (force-output)
+    (when (position ensure '(:absent nil))
+      (run "grep -v " (sh-quote pubkey) " " sh-ak " > " sh-ak-tmp)
+      (run "mv " sh-ak-tmp " " sh-ak))
+    (when (position ensure '(:present nil))
+      (run "echo " (sh-quote type " " pubkey " " name) " >> " sh-ak))))