Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -26,11 +26,11 @@ (declare (unit db)) (module db ( - * + db:setup ) (import scheme posix chicken data-structures ports) (use (prefix sqlite3 sqlite3:) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -42,12 +42,13 @@ (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) ;; (declare (uses daemon)) -;; (declare (uses db)) +(declare (uses db)) ;; (declare (uses dcommon)) +(import db) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -82,14 +82,15 @@ (define *area-info* (make-area)) (define *pktspec* `((server (hostname . h) (port . p) (pid . i) + (ipaddr . a) ) (data (hostname . h) ;; sender hostname (port . p) ;; sender port - (ip . a) ;; sender ip + (ipaddr . a) ;; sender ip (hostkey . k) ;; sending host key - store info at server under this key (servkey . s) ;; server key - this needs to match at server end or reject the msg (format . f) ;; sb=serialized-base64, t=text, sx=sexpr, j=json (data . d) ;; base64 encoded slln data ))) @@ -134,11 +135,11 @@ (begin (area-pktid-set! *area-info* (write-alist->pkt pktdir `((hostname . ,(get-host-name)) - (ip . ,best-ip) + (ipaddr . ,best-ip) (port . ,port-num) (pid . ,(current-process-id))) pktspec: *pktspec* ptype: 'server)) (area-pktfile-set! *area-info* (conc pktdir "/" (area-pktid *area-info*) ".pkt")))) @@ -197,11 +198,11 @@ ;; (print "received: " pktdat) (if (not (eof-object? dat)) (let ((resdat (proc dat))) (print "Got " dat) (print "Responding with " resdat) - (nmsg:send rep (with-output-to-string (lambda ()(write resdat)))) + (nmsg:send rep (sexpr->string resdat)) ;; (with-output-to-string (lambda ()(write resdat)))) (loop)))))) "message handler")) (th2 (make-thread (lambda () (let loop () @@ -218,11 +219,11 @@ ;; get the response ;; (define (server:receive rep) (let ((instr (nmsg:recv rep))) (if (string? instr) - (with-input-from-string instr read) + (string->sexpr instr) ;; (with-input-from-string instr read) instr))) (define (server:shutdown) (let ((conn (area-conn *area-info*)) (pktf (area-pktfile *area-info*)) @@ -236,10 +237,11 @@ (define (server:send-all msg) #f) ;; given a area record look up all the packets +;; (define (server:get-all-server-pkts rec) (let ((all-pkt-files (glob (conc (area-pktsdir rec) "/*.pkt")))) ;; (pktspec (area-pktspec rec))) (map (lambda (pkt-file) (read-pkt->alist pkt-file pktspec: *pktspec*)) @@ -255,11 +257,11 @@ ;; srvpkt is the info for the server we wish to send the message to ;; (define (server:send servpkt data action) (let* ((port (alist-ref 'port servpkt)) (host (alist-ref 'hostname servpkt)) - (ip (alist-ref 'ip servpkt)) + (ip (alist-ref 'ipaddr servpkt)) (hkey (alist-ref 'Z servpkt)) (addr (conc (or ip host) ":" port)) ;; fall back to host if ip not provided (myport (area-port *area-info*)) (myhost (area-myaddr *area-info*)) (mykey (area-pktid *area-info*)) @@ -272,14 +274,14 @@ (action . ,action) ;; formating of the message (data . ,data)) ;; *pktspec* ;; ptype: 'data)) ))))) - (print "msg: " msg) + ;; (print "msg: " msg) (if (and port host) - (begin - (print "sending " msg " to " addr) + (string->sexpr ;; begin + ;; (print "sending ")(pp msg)(print " to " addr) (nmsg:open-send-receive addr msg)) #f))) (define (server:get-my-best-address) (ip->string (car (filter (lambda (x) @@ -293,10 +295,20 @@ ;;====================================================================== ;; "Client side" operations ;;====================================================================== +;; convert to/from string / sexpr + +(define (string->sexpr str) + (if (string? str) + (with-input-from-string str read) + str)) + +(define (sexpr->string s) + (with-output-to-string (lambda ()(write s)))) + ;; is the server alive? ;; (define (server:ping servpkt) (let* ((start-time (current-milliseconds)) (res (server:send servpkt 'ping 'immediate))) @@ -304,18 +316,48 @@ res))) ;; (equal? res "got ping")))) ;; look up all pkts and get the server id (the hash), port, host/ip ;; store this info in the global struct *area-info* ;; -(define (server:get-all) +;; pass in *area-info* as rec +;; +(define (server:update-known-servers rec) ;; readll all pkts ;; foreach pkt; if it isn't me ping the server; if alive, add to hosts hash, else rm the pkt - (let ((all-pkts (server:get-all-server-pkts *area-info*))) + (let ((all-pkts (delete-duplicates + (append (server:get-all-server-pkts rec) + (hash-table-values (area-hosts rec))))) + (hostshash (area-hosts rec)) + (my-id (area-pktid rec)) + (pktsdir (area-pktsdir rec)) ;; needed to remove pkts from non-responsive servers + ) (for-each (lambda (servpkt) - (let* ((res (server:ping servpkt))) - (print "Got " res " from server " servpkt))) + (let* ((res (server:ping servpkt)) + (sid (alist-ref 'Z servpkt)) ;; Z code is our name for the server + ) + (match res + ((qduration . payload) + (print "Server pkt:")(pp servpkt) + (print "res: ")(pp res) + (match payload + ((code message) + (print "code: " code " message: " message) + (if code + (hash-table-set! hostshash sid servpkt) + (print "got #f from the server, not sure what that means!"))) + (else + (print "Got ")(pp res)(print " from server ")(pp servpkt) " but response did not match (#f/#t . msg)"))) + (else + ;; here we delete the pkt - can't reach the server, remove it + ;; however this logic is inadequate. we should mark the server as checked + ;; and not good, if it happens a second time - then remove the pkt + ;; or something similar. I.e. don't be too quick to assume the server is wedged or dead + ;; could be it is simply too busy to reply + (print "clearing out server " sid) + (delete-file* (conc pktsdir "/" sid ".pkt")) + (hash-table-delete! hostshash side))))) all-pkts))) ;; send out an "I'm about to exit notice to all known servers" ;; (define (server:imminent-death)