Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70-captain-ulex | v1.70-defunct-try |
Files: | files | file ages | folders |
SHA1: |
65faac60c7fae83d74b3fa5c34ada8d1 |
User & Date: | matt on 2020-01-01 21:11:17 |
Other Links: | branch diff | manifest | tags |
Context
2020-01-01
| ||
23:12 | wip check-in: 0b096cbab6 user: matt tags: v1.70-captain-ulex, v1.70-defunct-try | |
21:11 | wip check-in: 65faac60c7 user: matt tags: v1.70-captain-ulex, v1.70-defunct-try | |
2019-12-31
| ||
23:20 | Beginnings of captain based ulex check-in: 3dae400136 user: matt tags: v1.70-captain-ulex, v1.70-defunct-try | |
Changes
Modified commonmod.scm from [04522a0398] to [106c49900b].
︙ | ︙ | |||
1434 1435 1436 1437 1438 1439 1440 | ;; TEST DATA test-data-rollup csv->test-data ;; MISC sync-inmem->db | | | 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 | ;; TEST DATA test-data-rollup csv->test-data ;; MISC sync-inmem->db ;; TESTMETAl testmeta-add-record testmeta-update-field ;; TASKS tasks-add tasks-set-state-given-param-key )) |
︙ | ︙ |
Modified rmtmod.scm from [48b73c05c7] to [5550ea1678].
︙ | ︙ | |||
68 69 70 71 72 73 74 | #f))) (if cinfo cinfo (if (server:check-if-running areapath) (client:setup areapath) #f)))) | | | > > > > > > | 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 | #f))) (if cinfo cinfo (if (server:check-if-running areapath) (client:setup areapath) #f)))) ;; return the handle struct for sending queries to a specific database ;; - initializes the connection object if this is the first access ;; - finds the "captain" and asks who to talk to for the given dbfname ;; - establishes the connection to the current dbowner ;; (define (rmt:connect alldat dbfname) (let* ((ulexdat (let ((uconn (alldat-ulexdat alldat))) (if uconn uconn (let* ((new-ulexdat (ulex:setup))) ;; establish connection to ulex (alldat-ulexdat-set! alldat new-ulexdat) new-ulexdat))))) (ulex:connect ulexdat dbfname))) ;; set up a connection to the current owner of the dbfile associated with rid ;; then send the query to that dbfile owner and wait for a response. ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected (let* ((alldat *alldat*) (areapath (alldat-areapath alldat)) (dbfname (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db" "main.db" (conc rid ".db"))) (dbfile (conc areapath "/.db/" dbfname)) |
︙ | ︙ |
Modified ulex/ulex.scm from [c57e5ea36f] to [1ac73bf9c4].
︙ | ︙ | |||
22 23 24 25 26 27 28 | ;; See README in the distribution at https://www.kiatoa.com/fossils/ulex ;; NOTES: ;; Why sql-de-lite and not say, dbi? - performance mostly, then simplicity. ;; ;;====================================================================== ;; (use rpc pkts mailbox sqlite3) | | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | ;; See README in the distribution at https://www.kiatoa.com/fossils/ulex ;; NOTES: ;; Why sql-de-lite and not say, dbi? - performance mostly, then simplicity. ;; ;;====================================================================== ;; (use rpc pkts mailbox sqlite3) (module ulex * (import scheme posix chicken data-structures ports extras files mailbox) (import srfi-18 pkts matchable regex typed-records srfi-69 srfi-1 srfi-4 regex-case (prefix sqlite3 sqlite3:) foreign tcp6 ;; ulex-netutil hostinfo) ;;====================================================================== ;; network utilities ;;====================================================================== (define (rate-ip ipaddr) (regex-case ipaddr ( "^127\\..*" _ 0 ) ( "^(10\\.0|192\\.168)\\..*" _ 1 ) ( else 2 ) )) ;; Change this to bias for addresses with a reasonable broadcast value? ;; (define (ip-pref-less? a b) (> (rate-ip a) (rate-ip b))) (define (get-my-best-address) (let ((all-my-addresses (get-all-ips)) ;;(all-my-addresses-old (vector->list (hostinfo-addresses (hostname->hostinfo (get-host-name))))) ) (cond ((null? all-my-addresses) (get-host-name)) ;; no interfaces? ((eq? (length all-my-addresses) 1) (car all-my-addresses)) ;; only one to choose from, just go with it (else (car (sort all-my-addresses ip-pref-less?))) ;; (else ;; (ip->string (car (filter (lambda (x) ;; take any but 127. ;; (not (eq? (u8vector-ref x 0) 127))) ;; all-my-addresses)))) ))) (define (get-all-ips-sorted) (sort (get-all-ips) ip-pref-less?)) (define (get-all-ips) (map ip->string (vector->list (hostinfo-addresses (host-information (current-hostname)))))) ;; make it a global? Well, it is local to area module (define *captain-pktspec* `((captain (host . h) (port . p) (pid . i) |
︙ | ︙ | |||
57 58 59 60 61 62 63 | (defstruct udat (captain-address #f) (captain-host #f) (captain-port #f) (captain-pid #f) (cpkts-dir (conc (get-environment-variable "HOME") "/.ulex/pkts")) | | > > > > > > > > > > > | > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | (defstruct udat (captain-address #f) (captain-host #f) (captain-port #f) (captain-pid #f) (cpkts-dir (conc (get-environment-variable "HOME") "/.ulex/pkts")) (cpkt-spec *captain-pktspec*) (my-cpkt-key #f) ;; put Z card here when I create a pkt for myself as captain (my-address #f) (my-hostname #f) (my-port #f) (my-pid (current-process-id)) (serv-listener #f) ) ;;====================================================================== ;; Captain pkt functions ;;====================================================================== ;; given a pkts dir read ;; (define (get-all-captain-pkts udata) (let* ((pktsdir (let ((d (udat-cpkts-dir udata))) (if (file-exists? d) d (begin (create-directory d #t) d)))) (all-pkt-files (glob (conc pktsdir "/*.pkt"))) (pkt-spec (udat-cpkt-spec udata))) (map (lambda (pkt-file) (read-pkt->alist pkt-file pktspec: pkt-spec)) all-pkt-files))) ;; sort by D then Z, return one, choose the oldest then ;; differentiate if needed using the Z key ;; (define (get-winning-pkt pkts) (if (null? pkts) #f (car (sort pkts (lambda (a b) (let ((ad (string->number (alist-ref 'D a))) (bd (string->number (alist-ref 'D b)))) (if (eq? a b) (let ((az (alist-ref 'Z a)) (bz (alist-ref 'Z b))) (string>=? az bz)) (> ad bd)))))))) ;; create a tcp listener and return a populated udat struct with ;; my port, address, hostname, pid etc. ;; return #f if fail to find a port to allocate. ;; (define (start-server-find-port udata #!optional (port 9999)) (handle-exceptions exn (if (< port 65535)(start-server-find-port (+ port 1)) #f) (start-server udata port))) (define (start-server udata port) ;; (tcp-listener-socket LISTENER)(socket-name so) ;; sockaddr-address, sockaddr-port, sockaddr->string (let* ((tlsn (tcp-listen port 1000 #f)) ;; (tcp-listen TCPPORT [BACKLOG [HOST]]) (addr (get-my-best-address))) ;; (hostinfo-addresses (host-information (current-hostname))) (udat-my-address-set! udata addr) (udat-my-port-set! udata port) (udat-my-hostname-set! udata (get-host-name)) (udat-serv-listener-set! udata tlsn) udata)) ;; put the host, ip, port and pid into a pkt in ;; the captain pkts dir ;; - assumes user has already fired up a server ;; which will be in the udata struct ;; (define (create-captain-pkt udata) (if (not (udat-serv-listener udata)) (begin (print "ERROR: create-captain-pkt called with out a listener") #f) (let* ((pktdat `((port . ,(udat-my-port udata)) (host . ,(udat-my-hostname udata)) (ipaddr . ,(udat-my-address udata)) (pid . ,(udat-my-pid udata)))) (pktdir (udat-cpkts-dir udata)) (pktspec (udat-cpkt-spec udata)) ) (udat-my-cpkt-key-set! udata (write-alist->pkt pktdir pktdat pktspec: pktspec ptype: 'captain)) (udat-my-cpkt-key udata)))) ;;====================================================================== ;; connection setup and management functions ;;====================================================================== ;; find or become the captain, return a ulex object ;; (define (setup) (let* ((udata (make-udat)) (cpkts (get-all-captain-pkts udata)) ;; read captain pkts (captn (get-winning-pkt cpkts))) (if captn |
︙ | ︙ | |||
113 114 115 116 117 118 119 120 121 122 123 124 125 126 | ;; then run setup again ;; udata ))) (define (connect udata dbfname) udata) ;;; ;;====================================================================== ;;; ;; D E B U G H E L P E R S ;;; ;;====================================================================== ;;; ;;; (define (dbg> . args) ;;; (with-output-to-port (current-error-port) | > > > | 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | ;; then run setup again ;; udata ))) (define (connect udata dbfname) udata) ) ;; END OF ULEX ;;; ;;====================================================================== ;;; ;; D E B U G H E L P E R S ;;; ;;====================================================================== ;;; ;;; (define (dbg> . args) ;;; (with-output-to-port (current-error-port) |
︙ | ︙ | |||
158 159 160 161 162 163 164 | ;; http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html ;; ;; Syntax for defining macros in a simple style similar to function definiton, ;; when there is a single pattern for the argument list and there are no keywords. ;; ;; (define-simple-syntax (name arg ...) body ...) ;; | | | | | | | | | | | | | | | | | | | | | 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 | ;; http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html ;; ;; Syntax for defining macros in a simple style similar to function definiton, ;; when there is a single pattern for the argument list and there are no keywords. ;; ;; (define-simple-syntax (name arg ...) body ...) ;; ;; ;; (define-syntax define-simple-syntax ;; (syntax-rules () ;; ((_ (name arg ...) body ...) ;; (define-syntax name (syntax-rules () ((name arg ...) (begin body ...))))))) ;; ;; (define-simple-syntax (catch-and-dump proc procname) ;; (handle-exceptions ;; exn ;; (begin ;; (print-call-chain (current-error-port)) ;; (with-output-to-port (current-error-port) ;; (lambda () ;; (print ((condition-property-accessor 'exn 'message) exn)) ;; (print "Callback error in " procname) ;; (print "Full condition info:\n" (condition->list exn))))) ;; (proc))) ;; ;; ;;====================================================================== ;; R E C O R D S ;;====================================================================== ;;; ;; information about me as a server ;;; ;; ;;; (defstruct area |
︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 | ;;; ;;; ))) ;;; ;;; (define (get-all-ips-sorted) ;;; (sort (get-all-ips) ip-pref-less?)) ;;; ;;; | | | 1607 1608 1609 1610 1611 1612 1613 1614 | ;;; ;;; ))) ;;; ;;; (define (get-all-ips-sorted) ;;; (sort (get-all-ips) ip-pref-less?)) ;;; ;;; |