thodg/cl-unix-cybernetics

diff --git a/package.lisp b/package.lisp
index ed3c4e3..def9eca 100644
--- a/package.lisp
+++ b/package.lisp
@@ -146,6 +146,7 @@
    #:ssh-authorized-key
    #:stat
    #:stat<1>
+   #:symlink
    #:+timestamp-offset+
    #:timestamp-to-universal-time
    #:universal-time-to-timestamp
diff --git a/test.lisp b/test.lisp
index 7da15f0..fb184d0 100644
--- a/test.lisp
+++ b/test.lisp
@@ -32,6 +32,11 @@
 (adams:clear-resources)
 (adams:clear-probed)
 
+(resource 'symlink "/home/dx/test-symlink"
+          :owner "dx"
+          :group "dx"
+          :target "../test")
+
 (resource 'host "ams.kmx.io"
           :user "root"
           :hostname "ams"
diff --git a/unix/defs.lisp b/unix/defs.lisp
index 580bc09..ca7e6db 100644
--- a/unix/defs.lisp
+++ b/unix/defs.lisp
@@ -94,6 +94,19 @@
 (defgeneric op-file-ensure (resource os &key ensure))
 (defgeneric op-file-content (resource os &key content))
 
+;;  Symbolic link
+
+(define-resource-class symlink (vnode)
+  ()
+  ((probe-symlink-target :properties (:target)))
+  ((op-symlink-ensure :properties (:ensure))
+   (op-symlink-target :properties (:target)))
+  ((:op-properties (:ensure :target))))
+
+(defgeneric probe-symlink-target (resource os))
+(defgeneric op-symlink-ensure (resource os &key ensure))
+(defgeneric op-symlink-target (resource os &key target))
+
 ;;  Directory
 
 (define-resource-class directory (vnode)
diff --git a/unix/operations.lisp b/unix/operations.lisp
index 472fff3..5c89101 100644
--- a/unix/operations.lisp
+++ b/unix/operations.lisp
@@ -190,6 +190,28 @@
       (funcall (the function after) res os))
     (clear-probed res)))
 
+;;  Symlink
+
+(defmethod op-symlink-ensure ((res symlink) (os os-unix)
+                              &key ensure)
+  (sync-owner-and-group res)
+  (sync (parent-directory res))
+  (let* ((id (resource-id res))
+         (sh-id (sh-quote id))
+         (target (get-specified res :target))
+         (sh-target (sh-quote target)))
+    (ecase ensure
+      ((:absent) (run "rm " sh-id))
+      ((:present) (run "ln -s " sh-target " " sh-id))
+      ((nil)))))
+
+(defmethod op-symlink-target ((res symlink) (os os-unix)
+                              &key target)
+  (let* ((id (resource-id res))
+         (sh-id (sh-quote id))
+         (sh-target (sh-quote target)))
+    (run "ln -sf " sh-target " " sh-id)))
+
 ;;  Directory
 
 (defmethod op-directory-ensure ((res directory) (os os-unix)
diff --git a/unix/probes.lisp b/unix/probes.lisp
index c4cf2ce..51f032b 100644
--- a/unix/probes.lisp
+++ b/unix/probes.lisp
@@ -76,10 +76,10 @@
 (defmethod probe-vnode-using-ls ((vnode vnode) (os os-unix))
   (let ((id (resource-id vnode))
         (ensure :absent))
-    (multiple-value-bind #1=(mode links owner group size mtime)
+    (multiple-value-bind #1=(mode links owner group size mtime target)
         (with-ls<1>-lT #.(cons 'name '#1#)
             (ls "-ldT" id)
-          (when (string= id name)
+          (when (string= id (the string name))
             (setq mode (mode (mode-permissions mode))
                   owner (resource 'user owner)
                   group (resource 'group group)
@@ -144,6 +144,14 @@
                         :file-too-large))))
     (properties* content)))
 
+;;  Symlink
+
+(defmethod probe-symlink-target ((symlink symlink) (os os-unix))
+  (let ((target (string-trim '(#\Newline)
+                             (run "readlink "
+                                  (sh-quote (resource-id symlink))))))
+    (properties* target)))
+
 ;;  Directory
 
 (defmethod probe-directory-content ((dir directory) (os os-unix))
diff --git a/unix/syntaxes.lisp b/unix/syntaxes.lisp
index 0e438ce..5895bbd 100644
--- a/unix/syntaxes.lisp
+++ b/unix/syntaxes.lisp
@@ -41,10 +41,11 @@
 			 group
 			 (#'sh-parse-integer size)
 			 (#'chronicity:parse time)
-			 name)
-  #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+)$|
+			 name
+                         target)
+  #~|^([-a-zA-Z]{10})\s+([0-9]+)\s+(\S+)\s+(\S+)\s+([0-9]+)\s+(\S+\s+\S+ \S+ \S+)\s+(.+?)(?: -> (.*))?$|
   "Syntax for `ls -lT` output. See ls(1)."
-  (values name mode links owner group size time))
+  (values name mode links owner group size time target))
 
 (define-syntax stat<1>-r ((#'sh-parse-integer
 			   dev ino mode links uid gid rdev size)