Overview
Comment: | wip-no-compile |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-reshape |
Files: | files | file ages | folders |
SHA1: |
9f479c2454eda9c715efead307c08771 |
User & Date: | matt on 2023-01-29 22:01:00 |
Other Links: | branch diff | manifest | tags |
Context
2023-01-30
| ||
20:20 | wip check-in: a51a5d6058 user: matt tags: v1.80-reshape | |
2023-01-29
| ||
22:01 | wip-no-compile check-in: 9f479c2454 user: matt tags: v1.80-reshape | |
21:32 | Beginnings of client implemented check-in: bd65c3fcb5 user: matt tags: v1.80-reshape | |
Changes
Modified clientmod.scm from [8950d17727] to [dc86555194].
︙ | ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | (module clientmod * (import scheme posix data-structures srfi-18 artifacts servermod ) (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)) | > > > > > > > > > | > | > > > > > > > > | > | > > > | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | (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 )) ) |
Modified rmtmod.scm from [7009453b29] to [68caa1e403].
︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit rmtmod)) (declare (uses commonmod)) (declare (uses clientmod)) (module rmtmod * (import scheme clientmod ) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; ;; generate entries for ~/.megatestrc with the following ;; ;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; if a server is either running or in the process of starting call client:setup ;; else return #f to let the calling proc know that there is no server available ;; | > > > > > > > > > | > > > | > > > > > | < > > > > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit rmtmod)) (declare (uses commonmod)) (declare (uses clientmod)) (declare (uses dbmod)) (module rmtmod * (import scheme chicken data-structures posix srfi-1 srfi-18 srfi-69 extras clientmod dbmod ) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; ;; generate entries for ~/.megatestrc with the following ;; ;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; if a server is either running or in the process of starting call client:setup ;; else return #f to let the calling proc know that there is no server available ;; (define (rmt:get-connection-info areapath) ;; TODO: push areapath down. (if *runremote* *runremote* (begin (set! *runremote* (client:find-server areapath)) (con-obj-to-str-set! *runremote* db:obj->str) (con-host-set! *runremote* (get-host-name)) (con-pid-set! *runremote* (current-process-id)) *runremote*))) #;(let* ((cinfo (if (remote? runremote) (remote-conndat runremote) #f))) (if cinfo cinfo (if (server:check-if-running areapath) (client:setup areapath runremote) #f))) (define (rmt:on-homehost? runremote) #t #;(let* ((hh-dat (remote-hh-dat runremote))) (if (pair? hh-dat) (cdr hh-dat) (begin (debug:print-info 0 *default-log-port* "hh-dat="hh-dat) #f)))) ;;====================================================================== (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id (define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected (let* ((con (rmt:get-connection-info areapath))) (client:send-receive con cmd params))) ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected ;; #;(common:telemetry-log (conc "rmt:"(->string cmd)) ;; payload: `((rid . ,rid) ;; (params . ,params))) |
︙ | ︙ |