Added support for ccl.

Pascal J. Bourguignon [2015-08-07 06:39]
Added support for ccl.
Filename
ddns/client.lisp
ddns/generate-client.lisp
diff --git a/ddns/client.lisp b/ddns/client.lisp
index 9fb19d5..6c15123 100644
--- a/ddns/client.lisp
+++ b/ddns/client.lisp
@@ -38,8 +38,8 @@


 (defparameter *default-port*         8053)
-(defparameter *default-ddns-server*  "voyager.informatimago.com")
-(defparameter *default-secret-file* #P"dnskeys/ddns.secret")
+(defparameter *default-ddns-server*  "hubble.informatimago.com")
+(defparameter *default-secret-file*  #P"dnskeys/ddns.secret")

 (defun compute-token (hostname seed secret)
   (with-output-to-string (out)
@@ -47,6 +47,32 @@
       :for byte :across (md5:MD5SUM-SEQUENCE (concatenate 'string hostname "/" seed "/" secret))
       :do (format out "~:@(~2,'0X~)" byte))))

+(defun make-socket-external-format ()
+  #+clisp (ext:make-encoding :charset :iso-8859-1
+                             :line-terminator :dos
+                             :INPUT-ERROR-ACTION :erro
+                             :OUTPUT-ERROR-ACTION :error)
+  #+ccl '(:character-encoding  :iso-8859-1
+          :line-termination :crlf )
+  #-(or clisp ccl) (error "not implemented yet"))
+
+(defun connect (port host &key (external-format :default))
+  (declare (ignorable external-format))
+  #+clisp (socket:socket-connect port host :external-format external-format)
+  #+ccl   (ccl:make-socket :address-family :internet
+                             :type :stream
+                             :remote-host host
+                             :remote-port port
+                             :auto-close t
+                             :external-format external-format)
+  #-(or clisp ccl) (error "not implemented yet"))
+
+(defun arguments ()
+  #+clisp ext:*args*
+  #+ccl (rest ccl:*command-line-argument-list*)
+  #-(or clisp ccl) (error "not implemented yet"))
+
+
 (defun update (hostname &key
                (port        *default-port*)
                (ddns-server *default-ddns-server*)
@@ -54,7 +80,7 @@
   (let ((*print-pretty* nil)
         (*read-eval* nil)
         (*package* (find-package  "COM.INFORMATIMAGO.DDNS.CLIENT")))
-    (with-open-stream (socket (socket:socket-connect port ddns-server :external-format :dos))
+    (with-open-stream (socket  (connect port ddns-server :external-format (make-socket-external-format)))
       (let ((line (read-line socket)))
         (write-line line)
         (with-input-from-string (inp line)
@@ -81,10 +107,11 @@


 (defun main ()
-  (if (null ext:*args*)
-      (error "Missing argument, try: ddns-client -- kuiper")
-      (update (first ext:*args*)
-              ;; :ddns-server  "voyager.informatimago.com"
-              )))
+  (let ((arguments (arguments)))
+    (if (null arguments)
+        (error "Missing argument, try: ddns-client -- kuiper")
+        (update (first arguments)
+                ;; :ddns-server  "hubble.informatimago.com"
+                ))))

 ;;;; THE END ;;;;
diff --git a/ddns/generate-client.lisp b/ddns/generate-client.lisp
index 95b4a9a..8013d78 100644
--- a/ddns/generate-client.lisp
+++ b/ddns/generate-client.lisp
@@ -33,7 +33,6 @@
 ;;;;**************************************************************************

 (in-package "COMMON-LISP-USER")
-(require "syscalls")
 (setf *print-right-margin* 80
       *print-pretty* nil
       *print-case* :downcase)
@@ -69,36 +68,39 @@
 ;; (write-manifest *program-name* *program-system*)


-;; #+ccl (progn (princ "ccl:save-application will exit.") (terpri) (finish-output))
-;; #+ccl (ccl:save-application
-;;        (executable-filename *program-name*)
-;;        :toplevel-function (function com.informatimago.lse.cli:main)
-;;        :init-file nil
-;;        :error-handler :quit-quietly
-;;        ;; :application-class ccl:lisp-development-system
-;;        ;; :clear-clos-cache t
-;;        :purify nil
-;;        ;; :impurify t
-;;        :mode #o755
-;;        :prepend-kernel t
-;;        ;; :native t
-;;        )
-
-#+clisp (ext:saveinitmem
-         *program-name*
-         :quiet t
-         :verbose t
-         :norc t
-         :init-function (lambda ()
-                          (ext:exit (handler-case
-                                        (com.informatimago.ddns.client:main)
-                                      (error ()
-                                        1))))
-         :script t
-         :documentation "DDNS Client"
-         :start-package "COMMON-LISP-USER"
-         :keep-global-handlers nil
-         :executable t)
-#+clisp (ext:quit)
+#+ccl (progn
+        (ccl:save-application *program-name*
+                              :toplevel-function (function com.informatimago.ddns.client:main)
+                              :init-file nil
+                              :error-handler :quit-quietly
+                              ;; :application-class ccl:lisp-development-system
+                              ;; :clear-clos-cache t
+                              ;; :impurify t
+                              ;; :native t
+                              :purify nil
+                              :mode #o755
+                              :prepend-kernel t))
+
+#+clisp (progn
+          (ext:saveinitmem *program-name*
+                           :quiet t
+                           :verbose t
+                           :norc t
+                           :script t
+                           :init-function (lambda ()
+                                            (ext:exit (handler-case
+                                                          (com.informatimago.ddns.client:main)
+                                                        (error ()
+                                                          1))))
+                           :documentation "
+DDNS Client usage:
+
+    ddns-client -- $hostname
+
+"
+                           :start-package "COMMON-LISP-USER"
+                           :keep-global-handlers nil
+                           :executable t)
+          (ext:quit))

 ;;;; THE END ;;;;
ViewGit