thodg/cl-unix-cybernetics

diff --git a/adams.asd b/adams.asd
index 342f41d..564304e 100644
--- a/adams.asd
+++ b/adams.asd
@@ -60,6 +60,7 @@
    (:module "unix" :depends-on ("package" "shell" "core")
 	    :components
 	    ((:file "commands")
+	     (:file "debian" :depends-on ("commands" "defs"))
 	     (:file "defs")
 	     (:file "openbsd" :depends-on ("commands" "defs"))
 	     (:file "freebsd" :depends-on ("commands" "defs"))
diff --git a/core/defs.lisp b/core/defs.lisp
index 08d2714..984b1ec 100644
--- a/core/defs.lisp
+++ b/core/defs.lisp
@@ -168,7 +168,7 @@
 	    :type string)
    (name :initarg :name
 	 :reader os-name
-	 :type string)
+	 :type (or symbol string))
    (release :initarg :release
 	    :reader os-release
 	    :type string)
diff --git a/core/host.lisp b/core/host.lisp
index c67238c..9f02b52 100644
--- a/core/host.lisp
+++ b/core/host.lisp
@@ -126,28 +126,46 @@
   (with-host host
     (call-next-method)))
 
+(defun linux-name (name)
+  (when (string-equal (symbol-name 'linux) name)
+    'linux))
+
+(defun debian-version (version)
+  (when (search (symbol-name 'debian) version :test #'char-equal)
+    'debian))
+
 (defmethod probe-os-using-uname ((host host) (os t))
   (multiple-value-bind (name hostname release version machine) (uname)
     (declare (ignore hostname))
-    (let ((class (flet ((try (&rest parts)
-			  (when-let ((s (find-symbol (string-upcase (str 'os- parts))
-						     #.*package*)))
-			    (ignore-errors (find-class s)))))
-		   (or (try name '- release '- machine '- version)
-		       (try name '- release '- machine)
-		       (try name '- release '- version)
-		       (try name '- release)
-		       (try name '- machine '- version)
-		       (try name '- machine)
-		       (try name '- version)
-		       (try name)
-		       (warn "Unknown OS : ~A" name)))))
+    (let* ((name (or (linux-name name)
+                     name))
+           (distrib (or (debian-version version)))
+           (class (flet ((try (&rest parts)
+                           (when-let ((s (find-symbol (string-upcase (str 'os- parts))
+                                                      *package*)))
+                             (ignore-errors (find-class s)))))
+                    (or (try name '- release '- machine '- distrib)
+                        (try name '- release '- machine '- version)
+                        (try name '- release '- machine)
+                        (try name '- release '- distrib)
+                        (try name '- release '- version)
+                        (try name '- release)
+                        (try name '- machine '- distrib)
+                        (try name '- machine '- version)
+                        (try name '- machine)
+                        (try name '- distrib)
+                        (try name '- version)
+                        (try name)
+                        (warn "Unknown OS : ~A" name)))))
       (when class
-	(list :os (make-instance class
-				 :machine machine
-				 :name name
-				 :release release
-				 :version version))))))
+        (let ((plist (list :machine machine
+                           :name name
+                           :release release
+                           :version version)))
+          (when distrib
+            (setf plist (list* :distrib distrib plist)))
+          (let ((os (apply #'make-instance class plist)))
+            (list :os os)))))))
 
 (defmethod probe-hostname ((host host) (os os-unix))
   (list :hostname (first (run "hostname"))))
diff --git a/core/os.lisp b/core/os.lisp
index 3ac359f..c97dfae 100644
--- a/core/os.lisp
+++ b/core/os.lisp
@@ -40,7 +40,12 @@
 
 ;;  Linux
 
-(defclass os-linux (os-unix) ())
+(defclass os-linux (os-unix)
+  ((distrib :initarg :distrib
+            :accessor os-distrib
+            :type symbol)))
+
+(defclass os-linux-debian (os-linux) ())
 
 ;;  BSD
 
diff --git a/unix/debian.lisp b/unix/debian.lisp
new file mode 100644
index 0000000..1864cb7
--- /dev/null
+++ b/unix/debian.lisp
@@ -0,0 +1,56 @@
+;;
+;;  adams  -  Remote system administration tools
+;;
+;;  Copyright 2018 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 debian-pkg (pkg)
+  ()
+  ((probe-apt-pkg :properties (:versions))))
+
+(define-syntax apt<8>-list (name release version arch tags)
+  #~|([^/\s]+)(?:/([^\s]*))?\s+([^\s]+)\s+([^\s]+)(?:\s+\[([^\]]+)\])?|
+  "Syntax for apt(8) list on Linux Debian"
+  (values name release version arch (cl-ppcre:split "," tags)))
+
+(defmethod probe-host-packages ((host host) (os os-linux-debian))
+  (with-host host
+    (let ((packages))
+      (with-apt<8>-list (name release version arch tags)
+          (run "apt list | grep installed")
+        (let ((pkg (resource 'debian-pkg name)))
+          (add-probed-properties pkg (properties* name release version
+                                                  arch tags))
+          (push pkg packages)))
+      (list :packages (nreverse packages)))))
+
+#+nil
+(clear-resources)
+
+#+nil
+(describe-probed (resource 'openbsd-pkg "emacs"))
+
+#+nil
+(probe-installed-packages)
+
+#+nil
+(map nil #'describe-probed (probe-installed-packages))
+
+#+nil
+(run "pkg_info -q | grep emacs-")