alarm.scm

@@ -1,5 +1,5 @@
 ;;; Guile-ZWave -- Guile talks with ZWave devices.
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of Guile-ZWave.
 ;;;
@@ -24,11 +24,11 @@
              (srfi srfi-71)
              (ice-9 match))
 
-(define (run-alarm file)
-  (let ((port (open-zwave-serial-port file)))
+(define (run-alarm port)
+  (let ((init (initialize-zwave-state port)))
     (write-serial-message (make-request (message-class get-initial-data))
                           port)
-    (let loop ((state %zwave-initial-state))
+    (let loop ((state init))
       (match (select (list port) '() '())
         ((() () ())
          (loop state))
@@ -36,8 +36,9 @@
          (let* ((state1 (handle-response (pk 'msg (read-serial-message port))
                                          state))
                 (notification state2 (pop-zwave-state-notification state1)))
+           (pk 'nodes (zwave-state-nodes state2))
            (when notification
              (pk 'alarm notification))
            (loop state2)))))))
 
-(run-alarm (cadr (command-line)))
+(run-alarm (open-zwave-serial-port (cadr (command-line))))

inclusion.scm

@@ -0,0 +1,64 @@
+;;; Guile-ZWave -- Guile talks with ZWave devices.
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guile-ZWave.
+;;;
+;;; Guile-ZWave is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guile-ZWave is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guile-ZWave.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;; This program puts the ZWave controller in "device inclusion" mode.  Once
+;; it's started, you can set devices in inclusion mode as well (usually by
+;; double-clicking a button on the device), and that way they'll find each
+;; other.
+
+(use-modules (zwave)
+             (srfi srfi-71)
+             (ice-9 match))
+
+(define (run-device-inclusion port)
+  (let ((init (initialize-zwave-state port)))
+    (write-serial-message (make-request (message-class add-node-to-network)
+                                        #:high-power? #f
+                                        #:network-wide? #t)
+                          port)
+    (let loop ((state init))
+      (match (select (list port) '() '())
+        ((() () ())
+         (loop state))
+        (_
+         (let* ((message (read-serial-message port))
+                (notification state
+                              (pop-zwave-state-notification
+                               (handle-response message state))))
+           (match notification
+             (('inclusion-protocol-done . node)
+              (format #t "inclusion process complete, total ~a nodes:~%~s~%"
+                      (length (zwave-state-nodes state))
+                      (zwave-state-nodes state)))
+             (('included-node . node)
+              (format #t "included node ~s~%" node)
+              (loop state))
+             (('included-controller . node)
+              (format #t "included controller ~s~%" node)
+              (loop state))
+             (#f
+              (loop state))
+             ('failed
+              (format #t "inclusion failed~%")
+              (exit 1))
+             (event
+              (format #t "unknown inclusion event: ~s~%" event)
+              (loop state)))))))))
+
+(run-device-inclusion (open-zwave-serial-port (cadr (command-line))))

zwave.scm

@@ -1,5 +1,5 @@
 ;;; Guile-ZWave -- Guile talks with ZWave devices.
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of Guile-ZWave.
 ;;;
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-60)
   #:use-module (srfi srfi-71)
   #:export (open-zwave-serial-port
+            initialize-zwave-state
 
             message-type
             message-class
@@ -42,11 +43,11 @@
             write-serial-message
 
             make-request
-            %zwave-initial-state
             handle-response
 
             zwave-state?
             zwave-state-nodes
+            zwave-state-version
             pop-zwave-state-notification))
 
 (define-immutable-record-type <zwave-state>
@@ -83,6 +84,15 @@
 (define* (node id #:key (alive? #t) command-classes)
   (%node id alive? command-classes))
 
+(define (add-zwave-state-node state node)
+  "Add NODE to the list of nodes of STATE."
+  (let ((new-id (node-id node)))
+    (set-zwave-state-nodes
+     state
+     (cons node (remove (lambda (node)
+                          (= new-id (node-id node)))
+                        (zwave-state-nodes state))))))
+
 (define-syntax define-enumerate-type
   (syntax-rules ()
     ((_ record-type predicate
@@ -145,7 +155,8 @@
   (application-update            #x49)
   (get-suc-node-id               #x56) ;get ID of Static Update Controller (SUC)
   (explore-request-inclusion     #x5e)
-  (get-routing-info              #x80))
+  (get-routing-info              #x80)
+  (add-node-to-network           #x4a))   ;start the device inclusion process
 
 (define-record-type <serial-message>
   (serial-message type class payload)
@@ -173,7 +184,21 @@
                 (list node-id
                       0                           ;don't remove bad nodes
                       0                           ;don't remove non-repeaters
-                      3))))))
+                      3))))
+         (add-node-to-network
+          => (lambda* (#:key high-power? network-wide?)
+               ;; Send a request to start the device "inclusion" process.
+               ;; When HIGH-POWER? is false, the device has to be within one
+               ;; meter of the controller.  When NETWORK-WIDE? is true, hmm?
+               ;; See AddNodeMessageClass.java.
+               (define add-node-any 1)
+               (define option-high-power #x80)
+               (define option-network-wide #x40)
+
+               (u8-list->bytevector
+                (list (logior add-node-any
+                              (if high-power? option-high-power 0)
+                              (if network-wide? option-network-wide 0))))))))
 
 ;; Update types for 'application-update' messages.
 (define-enumerate-type <update-type>
@@ -321,6 +346,7 @@
   (non-interoperable #xf0))
 
 (define (lookup-node state id)
+  "Return the node with the given ID or #f."
   (find (lambda (node)
           (= id (node-id node)))
         (zwave-state-nodes state)))
@@ -375,16 +401,26 @@ accordingly."
                   (node (or (lookup-node state id)
                             (node id))))
              (pk 'newnode id)
-             (set-zwave-state-nodes
-              state
-              (cons (set-node-command-classes node
-                                              (read-command-classes payload))
-                    (remove (lambda (node)
-                              (= id (node-id node)))
-                            (zwave-state-nodes state))))))
+             (add-zwave-state-node state
+                                   (set-node-command-classes
+                                    node (read-command-classes payload)))))
           (else
            state))))
 
+(define (sub-bytevector bv start size)
+  "Return a copy of the SIZE bytes of BV starting from offset START."
+  (let ((result (make-bytevector size)))
+    (bytevector-copy! bv start result 0 size)
+    result))
+
+(define (handle-get-version message state)
+  "Handle MESSAGE, a 'get-version' reply that gives us the version string of
+the controller."
+  (let* ((payload (serial-message-payload message))
+         (library-type (bytevector-u8-ref payload 11))
+         (version (utf8->string (sub-bytevector payload 0 11))))
+    (set-zwave-state-version state version)))
+
 (define (handle-application-command-handler message state)
   (let* ((payload (serial-message-payload message))
          (node-id (bytevector-u8-ref payload 1))
@@ -394,11 +430,81 @@ accordingly."
     (push-zwave-state-notification state
                                    (cons class node-id))))
 
+(define (handle-add-node-to-network message state)
+  "Handle the 'add-node-to-network' request in MESSAGE."
+  ;; See AddNodeMessageClass.java.
+  (define status/learn-ready 1)
+  (define status/node-found 2)
+  (define status/adding-slave 3)                 ;XXX: despicable terminology
+  (define status/adding-controller 4)
+  (define status/protocol-done 5)
+  (define status/done 6)
+  (define status/failed 7)
+
+  (define (payload->command-classes payload)
+    ;; TODO: Factorize with 'read-command-classes'?
+    (let ((basic (bytevector-u8-ref payload 4))
+          (generic (bytevector-u8-ref payload 5))
+          (specific (bytevector-u8-ref payload 6)))
+      (let loop ((i 7)
+                 (classes '()))
+        (if (= i (bytevector-length payload))
+            (reverse classes)
+            (let ((integer (bytevector-u8-ref payload i)))
+              (match (false-if-exception (integer->command-class integer))
+                (#f    (loop (+ 1 i) classes))
+                (class (loop (+ 1 i) (cons class classes)))))))))
+
+  ;; TODO: Implement.
+  (let* ((payload (serial-message-payload message))
+         (status  (bytevector-u8-ref payload 1)))
+    (cond ((= status status/learn-ready)
+           (pk 'learn-ready)
+           state)
+          ((= status status/node-found)
+           (pk 'node-found!)
+           state)
+          ((= status status/adding-slave)
+           (let* ((id (bytevector-u8-ref payload 2))
+                  (classes (payload->command-classes payload))
+                  (node (node id #:command-classes classes)))
+             (add-zwave-state-node
+              (push-zwave-state-notification state
+                                             `(included-node . ,node))
+              (pk 'adding-slave node))))
+          ((= status status/adding-controller)
+           (pk 'adding-controller (bytevector-u8-ref payload 2))
+           (let ((id (bytevector-u8-ref payload 2))
+                 (classes (payload->command-classes payload)))
+             (add-zwave-state-node
+              (push-zwave-state-notification state
+                                             `(included-controller . ,node))
+              (pk 'adding-controller
+                  (node id #:command-classes classes)))))
+          ((= status status/protocol-done)
+           (let* ((id   (bytevector-u8-ref payload 2))
+                  (node (lookup-node state id)))
+             (pk 'protocol-done id node)
+             (push-zwave-state-notification state
+                                            `(inclusion-protocol-done . ,node))))
+          ((= status status/done)
+           (pk 'done (bytevector-u8-ref payload 2))
+           state)
+          ((= status status/failed)
+           (pk 'failed)
+           (push-zwave-state-notification state 'inclusion-failed))
+          (else
+           (format (current-error-port) "unknown add-node status: ~s~%"
+                   status)
+           state))))
+
 (define %response-handlers
   (vhash message-class
          (application-update => handle-application-update)
          (get-initial-data => handle-get-initial-data)
-         (application-command-handler => handle-application-command-handler)))
+         (get-version => handle-get-version)
+         (application-command-handler => handle-application-command-handler)
+         (add-node-to-network => handle-add-node-to-network)))
 
 (define (handle-response response state)
   "Return STATE updated according to RESPONSE."
@@ -412,7 +518,11 @@ accordingly."
           (else
            (match (vhash-assoc (serial-message-class response)
                                %response-handlers)
-             (#f state)
+             (#f
+              (format (current-error-port)
+                      "warning: no handler for response ~s~%"
+                      response)
+              state)
              ((_ . handle) (handle response state)))))))
 
 (define (make-request message-class . args)
@@ -474,7 +584,6 @@ Some requests take no arguments while others require some arguments."
            (bytevector-u8-set! bv (- len 1) 1)
            (bytevector-u8-set! bv (- len 1) (bytevector-checksum bv))
 
-           (pk 'put bv)
            (put-bytevector port bv)))))
 
 (define (read-serial-message port)
@@ -522,6 +631,18 @@ Some requests take no arguments while others require some arguments."
 ;;                           (command-class->integer command-class)
 ;;                           args))))
 
+(define (initialize-zwave-state port)
+  "Initialize ZWave state by sending a messages on PORT, and return the
+state."
+  (write-serial-message (make-request (message-class get-version))
+                        port)
+  (let loop ()
+    (let* ((message (read-serial-message port))
+           (state   (handle-response message %zwave-initial-state)))
+      (if (eq? state %zwave-initial-state) ;did we get a mere 'ack' or similar?
+          (loop)
+          state))))
+
 (define (open-zwave-serial-port file)
   (let ((port (open-file file "r+0")))
     ;; TODO: Open at 115200 baud 8N1.