Changes In Branch v1.64-better-archives Excluding Merge-Ins
This is equivalent to a diff from c0c5c1cbc3 to 3944bdfd6a
2017-12-06
| ||
16:54 | Merged in hierhash and minor edit check-in: 2f99cf9da6 user: mrwellan tags: v1.65 | |
2017-08-03
| ||
23:24 | Capturing forgotten edit Closed-Leaf check-in: 3944bdfd6a user: matt tags: v1.64-better-archives | |
2017-07-17
| ||
08:50 | Added simple script for observing close_wait check-in: 2d5edb0a67 user: mrwellan tags: v1.64 | |
2017-07-16
| ||
21:53 | Added hierhash check-in: f4498ccf0b user: matt tags: v1.64-better-archives | |
20:39 | First steps towards better archive handling check-in: 7323061194 user: matt tags: v1.64-better-archives | |
2017-07-14
| ||
17:29 | removed server-start from run check-in: c0c5c1cbc3 user: bjbarcla tags: v1.64 | |
17:21 | Added get-file-descriptor-count function to common.scm check-in: 09e3c49fcb user: jmoon18 tags: v1.64 | |
Modified common.scm from [794fa31626] to [2d1e82b36e].
1 2 3 4 5 6 7 8 9 10 11 | ;;====================================================================== ;; Copyright 2006-2012, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== | | | < | | | | < > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | ;;====================================================================== ;; Copyright 2006-2012, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== (use srfi-1 data-structures posix regex-case (prefix base64 base64:) format dot-locking csv-xml z3 ;; sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack matchable regex posix (srfi 18) extras ;; tcp (prefix nanomsg nmsg:) (prefix sqlite3 sqlite3:) ) (declare (unit common)) (include "common_records.scm") ;; (require-library margs) ;; (include "margs.scm") |
︙ | ︙ | |||
2269 2270 2271 2272 2273 2274 2275 | fallback-launcher (loop (car tal)(cdr tal))))))) ;; no match, try again (if (null? tal) fallback-launcher (loop (car tal)(cdr tal)))))))) fallback-launcher))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 | fallback-launcher (loop (car tal)(cdr tal))))))) ;; no match, try again (if (null? tal) fallback-launcher (loop (car tal)(cdr tal)))))))) fallback-launcher))) ;;====================================================================== ;; NMSG AND NEW API ;;====================================================================== ;; nm based server ;; (define (nm:start-server dbconn #!key (given-host-name #f)) (let* ((srvdat (start-raw-server given-host-name: given-host-name)) (host-name (srvdat-host srvdat)) (soc (srvdat-soc srvdat))) ;; start the queue processor (save for second round of development) ;; (thread-start! (queue-processory dbconn) "Queue processor") ;; msg is an alist ;; 'r host:port <== where to return the data ;; 'p params <== data to apply the command to ;; 'e j|s|l <== encoding of the params. default is s (sexp), if not specified is assumed to be default ;; 'c command <== look up the function to call using this key ;; (let loop ((msg-in (nn-recv soc))) (if (not (equal? msg-in "quit")) (let* ((dat (decode msg-in)) (host-port (alist-ref 'r dat)) ;; this is for the reverse req rep where the server is a client of the original client (params (alist-ref 'p dat)) (command (let ((c (alist-ref 'c dat)))(if c (string->symbol c) #f))) (all-good (and host-port params command (hash-table-exists? *commands* command)))) (if all-good (let ((cmddat (make-qitem command: command host-port: host-port params: params))) (queue-push cmddat) ;; put request into the queue (nn-send soc "queued")) ;; reply with "queued" (print "ERROR: BAD request " dat)) (loop (nn-recv soc))))) (nn-close soc))) ;;====================================================================== ;; D A S H B O A R D U S E R V I E W S ;;====================================================================== ;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists ;; (define (common:load-views-config) (let* ((view-cfgdat (make-hash-table)) (home-cfgfile (conc (get-environment-variable "HOME") "/.mtviews.config")) (mthome-cfgfile (conc *toppath* "/.mtviews.config"))) (if (common:file-exists? mthome-cfgfile) (read-config mthome-cfgfile view-cfgdat #t)) ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas (if (common:file-exists? home-cfgfile) (read-config home-cfgfile view-cfgdat #t)) view-cfgdat)) ;;====================================================================== ;; H I E R A R C H I C A L H A S H T A B L E S ;;====================================================================== ;; Every element including top element is a vector: ;; <vector subhash value> (define (hh:make-hh #!key (ht #f)(value #f)) (vector (or ht (make-hash-table)) value)) ;; used internally (define-inline (hh:set-ht! hh ht) (vector-set! hh 0 ht)) (define-inline (hh:get-ht hh) (vector-ref hh 0)) (define-inline (hh:set-value! hh value) (vector-set! hh 1 value)) (define-inline (hh:get-value hh value) (vector-ref hh 1)) ;; given a hierarchial hash and some keys look up the value ... ;; (define (hh:get hh . keys) (if (null? keys) (vector-ref hh 1) ;; we have reached the end of the line, return the value sought (let ((sub-ht (hh:get-ht hh))) (if sub-ht ;; yes, there is more hierarchy (let ((sub-hh (hash-table-ref/default sub-ht (car keys) #f))) (if sub-hh (apply hh:get sub-hh (cdr keys)) #f)) #f)))) ;; given a hierarchial hash, a value and some keys, add needed hierarcy and insert the value ;; (define (hh:set! hh value . keys) (if (null? keys) (hh:set-value! hh value) ;; we have reached the end of the line, store the value (let ((sub-ht (hh:get-ht hh))) (if sub-ht ;; yes, there is more hierarchy (let ((sub-hh (hash-table-ref/default sub-ht (car keys) #f))) (if (not sub-hh) ;; we'll need to add the next level of hierarchy (let ((new-sub-hh (hh:make-hh))) (hash-table-set! sub-ht (car keys) new-sub-hh) (apply hh:set! new-sub-hh value (cdr keys))) (apply hh:set! sub-hh value (cdr keys)))) ;; call the sub-hierhash with remaining keys (begin (hh:set-ht! hh (make-hash-table)) (apply hh:set! hh value keys)))))) |
Modified mtut.scm from [1f120769b0] to [8c33d3e1d2].
︙ | ︙ | |||
13 14 15 16 17 18 19 | ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras) srfi-18 extras format pkts pkts regex regex-case (prefix dbi dbi:) (prefix nanomsg nmsg:)) | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras) srfi-18 extras format pkts pkts regex regex-case (prefix dbi dbi:) (prefix nanomsg nmsg:)) test (declare (uses common)) (declare (uses megatest-version)) (declare (uses margs)) (declare (uses configf)) ;; (declare (uses rmt)) (include "megatest-fossil-hash.scm") |
︙ | ︙ | |||
985 986 987 988 989 990 991 | (system (conc "/bin/cat " schema-file))))) ((sqlite3schema) (let* ((install-home (common:get-install-area)) (schema-file (conc install-home "/share/db/mt-sqlite3.sql"))) (if (common:file-exists? schema-file) (system (conc "/bin/cat " schema-file))))) ((junk) | | > | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 | (system (conc "/bin/cat " schema-file))))) ((sqlite3schema) (let* ((install-home (common:get-install-area)) (schema-file (conc install-home "/share/db/mt-sqlite3.sql"))) (if (common:file-exists? schema-file) (system (conc "/bin/cat " schema-file))))) ((junk) (rmt:get-keys)))))) )) ;; If HTTP_HOST is defined then we must be in the cgi environment ;; so run stml and exit ;; (if (get-environment-variable "HTTP_HOST") (begin (stml:main #f) |
︙ | ︙ |