;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               client.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;
;;;;
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2012-04-08 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    AGPL3
;;;;
;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
;;;;
;;;;    This program is free software: you can redistribute it and/or modify
;;;;    it under the terms of the GNU Affero General Public License as published by
;;;;    the Free Software Foundation, either version 3 of the License, or
;;;;    (at your option) any later version.
;;;;
;;;;    This program 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 Affero General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Affero General Public License
;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************

(defpackage "COM.INFORMATIMAGO.DDNS.CLIENT"
  (:use "COMMON-LISP" "MD5")
  (:export "UPDATE" "MAIN"))
(in-package "COM.INFORMATIMAGO.DDNS.CLIENT")


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

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

(defun update (hostname &key
               (port        *default-port*)
               (ddns-server *default-ddns-server*)
               (secret-file (merge-pathnames *default-secret-file* (user-homedir-pathname))))
  (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))
      (let ((line (read-line socket)))
        (write-line line)
        (with-input-from-string (inp line)
          (let ((code (read inp))
                (ddns (read inp))
                (seed (read inp)))
            (if (and (integerp code)
                     (= 2 (truncate code 100))
                     (eql 'ddns ddns)
                     (stringp seed))
                (let ((message  (list (compute-token
                                       hostname
                                       seed
                                       (with-open-file (stream secret-file) (read-line stream)))
                                      hostname)))
                  (format t "~S~%" message)
                  (force-output)
                  (prin1 message socket)
                  (finish-output socket)
                  (loop
                    :for line = (read-line socket nil nil)
                    :while line
                    :do (write-line line))))))))))


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

;;;; THE END ;;;;
ViewGit