
;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest 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.
;; 
;;     Megatest 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 Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; C L I E N T S
;;======================================================================

;;(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
;;     message-digest matchable spiffy uri-common intarweb http-client
;;     spiffy-request-vars uri-common intarweb directory-utils)

(declare (unit clientmod))
(declare (uses servermod))
(declare (uses artifacts))
(declare (uses debugprint))

(module clientmod
*

(import scheme
	chicken

	posix
	data-structures
	srfi-18
	typed-records

	artifacts
	servermod
	debugprint
	)

(defstruct con ;; client connection
  (hdir       #f) ;; this is the directory sdir/serverhost.serverpid
  (sdir       #f)
  (obj-to-str #f)
  (str-to-obj #f)
  (host       #f)
  (pid        #f)
  (sdat       #f) ;; server artifact data
  (areapath   #f)
  )

(define *my-client-signature* #f)

(define (client:find-server areapath)
  (let* ((sdir  (conc areapath"/.server"))
	 (sarfs (glob (conc sdir"/*.artifact")))) ;; server artifacts
    (if (null? sarfs)
	(begin
	  (server:launch areapath)
	  (thread-sleep! 1)
	  (client:find-server areapath))
	(let* ((sarf (car sarfs))
	       (sdat (read-artifact->alist sarf))
	       (hdir (alist-ref 'd sdat)))
	  (make-con hdir: hdir sdir: sdir sdat: sdat)))))

;; move this into artifacts
;; find the artifact with key set to val
;;
(define (client:find-artifact arfs key val)
  (let loop ((rem arfs))
    (if (null? rem) ;; didn't find a match
	#f
	(let* ((arf       (car rem))
	       (adat      (read-artifact->alist arf))
	       (val-found (alist-ref key adat)))
	  (if (equal? val-found val)
	      (cons (cons 'path arf) adat) ;; return the artifact as alist anotated with 'path
	      (loop (cdr rem)))))))

(define (client:send-receive con cmd params)
  (let* ((obj->string (con-obj-to-str con))
	 (string->obj (con-str-to-obj con))
	 (arf  `((c . ,cmd)
		 (p . ,(obj->string params))
		 (h . ,(con-host con))  ;; tells server where to put response
		 (i . ,(con-pid  con))));; and is where this client looks
	 (hdir  (con-hdir con))
	 (sdir  (con-sdir con))
	 (uuid  (write-alist->artifact hdir arf ptype: 'Q))
	 (respdir (conc sdir"/"(con-host con)"."(con-pid con)"/responses")))
    (let loop ((start (current-milliseconds)))
      (let* ((arfs (glob (conc respdir"/*.artifact")))
	     (res  (client:find-artifact arfs 'P uuid)))
	(if res ;; we found our response!
	    (let ((arf  (alist-ref 'path res))
		  (rstr (alist-ref 'r res)))
	      (delete-file arf) ;; done with it, future - move to archive area
	      (string->obj rstr))
	    (begin ;; no response yet, look again in 500ms
	      (thread-sleep! 0.5)
	      (loop (current-milliseconds))))))))

;; client:get-signature
(define (client:get-signature)
  (if *my-client-signature* *my-client-signature*
      (let ((sig (conc (get-host-name) " " (current-process-id))))
	(set! *my-client-signature* sig)
	*my-client-signature*)))

)

