Megatest

Artifact [dc86555194]
Login

Artifact dc865551941314e2a78857cdf71bfdd2df10d272:



;; 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))

(module clientmod
*

(import scheme
	posix
	data-structures
	srfi-18
	typed-records

	artifacts
	servermod
	)

(defstruct con ;; client connection
  (hdir       #f)
  (obj-to-str #f)
  (host       #f)
  (pid        #f)
  (sdat       #f) ;; server artifact data
  )

(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 sdat: sdat)))))

(define (client:send-receive con cmd params)
  (let* ((obj->string (con-obj-to-str con))
	 (arf  `((c . ,cmd)
		 (p . ,(obj->string params))
		 (h . ,(con-host con))
		 (i . ,(con-pid  con))))
	 (hdir  (con-hdir con))
	 (uuid  (write-alist->artifact hdir arf ptype: 'Q)))
    
    ;; wait for a response here

    #f
    ))

)