Changes In Branch v2.001 Through [c423bc098e] Excluding Merge-Ins
This is equivalent to a diff from 3ebb15bd95 to c423bc098e
2021-12-14
| ||
20:05 | Mostly got unit tests working again. check-in: c7197c92dd user: matt tags: v2.001 | |
2021-12-13
| ||
19:56 | Fixed bunch of issues with main.db server startup. check-in: c423bc098e user: matt tags: v2.001 | |
2021-12-08
| ||
21:40 | Fixed bunch of build issues with autoload and dbi check-in: ffe0a27e42 user: matt tags: v2.001 | |
2021-12-01
| ||
19:25 | Start of v2.0 (again) check-in: 35ec63886f user: matt tags: v2.001 | |
2021-11-29
| ||
18:41 | Corrected - but not quite - the calls to get-inmem Leaf check-in: 3ebb15bd95 user: matt tags: v1.6584-nanomsg | |
09:38 | wip check-in: 31c178ba40 user: matt tags: v1.6584-nanomsg | |
Added build-assist/README version [d108fc0f5b].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 26 27 28 | Here is how I like to install chicken for building Megatest. This guide assumes you have the Megatest fossil and are in the build-assist directory and that you have the opensrc fossil with uv synced: fossil clone https://www.kiatoa.com/fossils/megatest fossil clone https://www.kiatoa.com/fossils/opensrc;cd opensrc;fossil uv sync Make a build directory and go to it: mkdir build;cd build Make a destination directory and set PREFIX export PREFIX=/opt/chicken/5.3.0; mkdir -p $PREFIX Get chicken: wget https://code.call-cc.org/releases/5.3.0/chicken-5.3.0.tar.gz Extract, build, and install chicken: tar xf chicken-5.3.0.tar.gz; cd chicken-5.3.0; make PLATFORM=linux PREFIX=$PREFIX install; cd .. Install all needed eggs. for egg in $(cat ../ck5-egg.list);do echo $egg;ck5 chicken-install $egg;done Now run the script ../iup-compile.sh for remaining instructions |
Modified build-assist/ck5 from [a0370c68ea] to [e0bdd3a902].
1 | #!/bin/bash | > > > | > > | > > | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | #!/bin/bash # /opt/chicken/5.3.0 # WHICHCKVER=5.1.0_WW45 WHICHCKVER=5.3.0 BASEDIR=/opt/chicken/$WHICHCKVER export PATH="$BASEDIR/bin:$PATH" NEW_LD_LIBRARY_PATH="$BASEDIR/lib:$BASEDIR/lib64" if [[ -z "$LD_LIBRARY_PATH" ]];then export LD_LIBRARY_PATH=$NEW_LD_LIBRARY_PATH else export LD_LIBRARY_PATH="$NEW_LD_LIBRARY_PATH:$LD_LIBRARY_PATH" fi exec "$@" |
Modified build-assist/ck5-eggs.list from [4ccb4f5090] to [50ec309d57].
1 2 3 4 5 6 7 | address-info ansi-escape-sequences apropos base64 crypt csv-abnf directory-utils | > | 1 2 3 4 5 6 7 8 | csm address-info ansi-escape-sequences apropos base64 crypt csv-abnf directory-utils |
︙ | ︙ |
Added build-assist/installing-nng version [9ef49d4af4].
> > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | wget https://github.com/nanomsg/nng/archive/refs/tags/v1.5.2.tar.gz tar xf v1.5.2.tar.gz cd nng-1.5.2 mkdir build cd build make sudo make install vi CMakeCache.txt Change OFF to ON for shared libraries: //Build shared library BUILD_SHARED_LIBS:BOOL=ON make sudo make install sudo ldconfig chicken-install nng -or- git clone https://gitlab.com/ariSun/chicken-nng.git cd chicken-ngg;chicken-install |
Modified build-assist/iup-compile.sh from [a1231c7291] to [f2fe37f920].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | if [[ -z $PREFIX ]];then echo "PREFIX required" exit fi echo "Put iup, im and cd .a and .so files in PREFIX/lib" echo " 1. get opensrc fossil from https://www.kiatoa.com/fossils/opensrc" echo " 2. list the unversioned files and export the cd, im and iup lib for your kernel (try uname -a for the kernel number) 4.15 ==> 415_64" echo " 3. untar iup, im and cp tars into a clean working dir and then copy:" echo " cp *.a *.so $PREFIX/lib" echo " cp include/*.h $PREFIX/include" echo " 4. run the chicken-install like this:" echo "If you use a wrapper (e.g. ck5) to create the chicken environment:" echo "CSC_OPTIONS=\"-I$PREFIX/include -I$PREFIX/include/im -I$PREFIX/include/cd -I$PREFIX/include/iup -L$PREFIX/lib -C -std=gnu99\" ck5 chicken-install iup -feature disable-iup-matrixex" echo "else:" | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | if [[ -z $PREFIX ]];then echo "PREFIX required" exit fi echo "Put iup, im and cd .a and .so files in PREFIX/lib" echo " 1. get opensrc fossil from https://www.kiatoa.com/fossils/opensrc" echo " 2. list the unversioned files and export the cd, im and iup lib for your kernel (try uname -a for the kernel number) 4.15 ==> 415_64" echo ' for x in $(fossil uv list | grep 415| awk ''{print $6}'');do targ=$(echo $x|cut -d/ -f3); fossil uv export $x $targ; done' echo " 3. untar iup, im and cp tars into a clean working dir and then copy:" echo " find . -name \*.a -print -exec cp {} $PREFIX/lib \;" echo " find . -name \*.so -print -exec cp {} $PREFIX/lib \;" echo " rsync -av include/ $PREFIX/include/" echo " or (depending on versions and what you see in the iup tars - they seem to vary" echo " cp *.a *.so $PREFIX/lib" echo " cp include/*.h $PREFIX/include" echo " 4. run the chicken-install like this:" echo "If you use a wrapper (e.g. ck5) to create the chicken environment:" echo "CSC_OPTIONS=\"-I$PREFIX/include -I$PREFIX/include/im -I$PREFIX/include/cd -I$PREFIX/include/iup -L$PREFIX/lib -C -std=gnu99\" ck5 chicken-install iup -feature disable-iup-matrixex" echo "else:" |
︙ | ︙ |
Modified dashboard.scm from [733ea55f33] to [955f1d46eb].
︙ | ︙ | |||
40 41 42 43 44 45 46 47 48 49 50 51 52 53 | (declare (uses runsmod)) (declare (uses rmtmod)) (declare (uses subrunmod)) (declare (uses tree)) (declare (uses vgmod)) (declare (uses testsmod)) (declare (uses tasksmod)) ;; needed for configf scripts, scheme etc. ;; (declare (uses apimod.import)) ;; (declare (uses debugprint.import)) ;; (declare (uses mtargs.import)) ;; (declare (uses commonmod.import)) ;; (declare (uses configfmod.import)) | > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (declare (uses runsmod)) (declare (uses rmtmod)) (declare (uses subrunmod)) (declare (uses tree)) (declare (uses vgmod)) (declare (uses testsmod)) (declare (uses tasksmod)) (declare (uses dbi)) ;; needed for configf scripts, scheme etc. ;; (declare (uses apimod.import)) ;; (declare (uses debugprint.import)) ;; (declare (uses mtargs.import)) ;; (declare (uses commonmod.import)) ;; (declare (uses configfmod.import)) |
︙ | ︙ | |||
87 88 89 90 91 92 93 94 95 96 97 98 99 100 | chicken.time chicken.time.posix (prefix iup iup:) canvas-draw canvas-draw-iup (prefix sqlite3 sqlite3:) srfi-1 regex regex-case srfi-69 typed-records sparse-vectors format srfi-4 srfi-14 | > | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | chicken.time chicken.time.posix (prefix iup iup:) canvas-draw canvas-draw-iup (prefix sqlite3 sqlite3:) (prefix dbi dbi:) srfi-1 regex regex-case srfi-69 typed-records sparse-vectors format srfi-4 srfi-14 |
︙ | ︙ | |||
2840 2841 2842 2843 2844 2845 2846 | (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) | | | 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 | (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) (tab-start-num 6) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW ;; (data (dboard:tabdat-init (make-d:data))) (additional-views ;; process views-dat (let ((tab-num tab-start-num) (result '())) (for-each (lambda (view-name) (debug:print 0 *default-log-port* "Adding view " view-name) |
︙ | ︙ | |||
2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 | "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view ;; (make-runs-view commondat runs2-dat 2) (dashboard:runs-summary commondat onerun-dat tab-num: 2) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) additional-views))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") ;; (iup:attribute-set! tabs "TABTITLE2" "Runs2") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") ;; (iup:attribute-set! tabs "TABTITLE3" "New View") ;; (iup:attribute-set! tabs "TABTITLE4" "Run Control") ;; set the tab names for user added tabs (for-each (lambda (tab-info) (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info))) | > > > | 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 | "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view ;; (make-runs-view commondat runs2-dat 2) (dashboard:runs-summary commondat onerun-dat tab-num: 2) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) (iup:vbox (iup:button "Pushme")) ;; tab 5 additional-views))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") ;; (iup:attribute-set! tabs "TABTITLE2" "Runs2") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") (iup:attribute-set! tabs "TABTITLE5" "Sys Status") ;; (iup:attribute-set! tabs "TABTITLE3" "New View") ;; (iup:attribute-set! tabs "TABTITLE4" "Run Control") ;; set the tab names for user added tabs (for-each (lambda (tab-info) (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info))) |
︙ | ︙ |
Modified dbi.scm from [3f996117f2] to [b3324417ec].
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 | ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit dbi)) (include "dbi/dbi.scm") | > | 15 16 17 18 19 20 21 22 23 24 | ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit dbi)) (declare (uses autoload)) (include "dbi/dbi.scm") |
Modified dbmod.scm from [7cd57dd118] to [ddeeddaa42].
︙ | ︙ | |||
42 43 44 45 46 47 48 | db:get-dbdat db:get-inmem db:get-ddb db:open-dbdat db:open-run-db db:open-inmem-db db:setup | | > | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | db:get-dbdat db:get-inmem db:get-ddb db:open-dbdat db:open-run-db db:open-inmem-db db:setup ;; db:get-main-lock db:with-lock-db db:get-iam-server-lock db:get-locker db:take-lock db:steal-lock-db db:release-lock db:general-sqlite-error-dump db:first-result-default db:generic-error-printout db:with-db db:set-sync db:get-last-update-time |
︙ | ︙ | |||
509 510 511 512 513 514 515 | ;; NOTE: ;; These operate directly on the disk file, NOT on the inmemory db ;; The lockname is the filename (can have many to one, run-id to fname ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; | | | < > | | | | > > > > > | 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 | ;; NOTE: ;; These operate directly on the disk file, NOT on the inmemory db ;; The lockname is the filename (can have many to one, run-id to fname ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; #;(define (db:get-main-lock dbfile) (db:with-lock-db dbfile (lambda (dbh dbfile) (db:get-iam-server-lock dbh dbfile)))) (define (db:with-lock-db dbfile proc) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) (res (proc dbh dbfile))) ;; (sqlite3:finalize! dbh) res)) ;; called before db is open? ;; (define (db:get-iam-server-lock dbh dbfname port) (sqlite3:with-transaction dbh (lambda () (let* ((locker (db:get-locker dbh dbfname))) (if locker locker (db:take-lock dbh dbfname port)))))) ;; (exn sqlite3) (define (db:get-locker dbh dbfname) (condition-case (sqlite3:first-row dbh "SELECT owner_pid,owner_host,owner_port,event_time FROM locks WHERE lockname=?;" dbfname) (exn (sqlite3) #f))) ;; should never fail because it is run in a transaction with a test for the lock ;; (define (db:take-lock dbh dbfname port) ;; (condition-case ;; (begin (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port) ;; #t) ;; (exn (sqlite3) #f))) #t) (define (db:steal-lock-db dbh dbfname port) (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname) (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port) #t) (define (db:release-lock dbh dbfname) (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname)) ;;====================================================================== ;; SQLITE3 HELPERS ;;====================================================================== |
︙ | ︙ | |||
1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 | db (lambda () (sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks (id INTEGER PRIMARY KEY, lockname TEXT, owner_pid INTEGER, owner_host TEXT, event_time TIMESTAMP DEFAULT (strftime('%s','now')), CONSTRAINT lock_constraint UNIQUE (lockname));") ;; maps to *srvpktspec* from http-transportmod (sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY, host TEXT, | > | 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 | db (lambda () (sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks (id INTEGER PRIMARY KEY, lockname TEXT, owner_pid INTEGER, owner_host TEXT, owner_port TEXT, event_time TIMESTAMP DEFAULT (strftime('%s','now')), CONSTRAINT lock_constraint UNIQUE (lockname));") ;; maps to *srvpktspec* from http-transportmod (sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers (id INTEGER PRIMARY KEY, host TEXT, |
︙ | ︙ |
Modified rmtmod.scm from [db7ecb31bf] to [a1b386ab00].
︙ | ︙ | |||
297 298 299 300 301 302 303 | ))) ;;====================================================================== ;; FOR DEBUGGING SET TO #t | | > | 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 | ))) ;;====================================================================== ;; FOR DEBUGGING SET TO #t ;; (define *localmode* #t) (define *localmode* #f) (define *dbstruct* (make-dbr:dbstruct)) ;; Defaults to current area ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote))) (let* ((apath *toppath*) |
︙ | ︙ | |||
1485 1486 1487 1488 1489 1490 1491 | (inmem (dbr:dbdat-db dbdat)) ) ;; do a final sync here (debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds)) (db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t) ;; let's finalize here (debug:print-info 0 *default-log-port* "Finalizing db and inmem") | > | > > | > | 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 | (inmem (dbr:dbdat-db dbdat)) ) ;; do a final sync here (debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds)) (db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t) ;; let's finalize here (debug:print-info 0 *default-log-port* "Finalizing db and inmem") (if (sqlite3:database? db) (sqlite3:finalize! db) (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, db is not a database, not finalizing...")) (if (sqlite3:database? inmem) (sqlite3:finalize! inmem) (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, inmem is not a database, not finalizing...")) (debug:print-info 0 *default-log-port* "Finalizing db and inmem complete") (if am-server (if (string-match ".*/main.db$" dbfile) (let ((pkt-file (conc (get-pkts-dir *toppath*) "/" (servdat-uuid *server-info*) ".pkt"))) (debug:print-info 0 *default-log-port* "removing pkt "pkt-file) |
︙ | ︙ | |||
1814 1815 1816 1817 1818 1819 1820 | ;;====================================================================== ;; NEW SERVER METHOD ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; | | | | > > > > > > > > > > > > | 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 | ;;====================================================================== ;; NEW SERVER METHOD ;;====================================================================== ;; only use for main.db - need to re-write some of this :( ;; (define (get-lock-db sdat dbfile port) (let* ((dbh (db:open-run-db dbfile db:initialize-db)) ;; open-run-db creates a standard db with schema used by all situations (res (db:get-iam-server-lock dbh dbfile port))) ;; res => list then already locked, check server is responsive ;; => #t then sucessfully got the lock ;; => #f reserved for future use as to indicate something went wrong (match res ((owner_pid owner_host owner_port event_time) (if (server-ready? owner_host owner_port "abc") #f (begin (debug:print 0 *default-log-port* "WARNING: stale lock - have to steal it. This may fail.") (db:steal-lock-db dbh dbfile port)))) (#t #t) ;; placeholder so that we don't touch res if it is #t (else (set! res #f))) (sqlite3:finalize! dbh) res)) (define (register-server pkts-dir pkt-spec host port servkey ipaddr dbpath) (let* ((pkt-dat `((host . ,host) (port . ,port) |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 | (if (null? tail) res ;; NOTE: sort by age so oldest is considered first (let* ((spkt (car tail))) (loop (cdr tail) (if (equal? dbpath (alist-ref 'dbpath spkt)) (cons spkt res) res)))))) ;; from viable servers get one that is alive and ready ;; (define (get-the-server apath serv-pkts) (let loop ((tail serv-pkts)) (if (null? tail) #f | > > > > > > > > > > > > > > > > > > > | 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 | (if (null? tail) res ;; NOTE: sort by age so oldest is considered first (let* ((spkt (car tail))) (loop (cdr tail) (if (equal? dbpath (alist-ref 'dbpath spkt)) (cons spkt res) res)))))) (define (remove-pkts-if-not-alive serv-pkts) (filter (lambda (pkt) (let* ((host (alist-ref 'host pkt)) (port (alist-ref 'port pkt)) (key (alist-ref 'servkey pkt)) (pktz (alist-ref 'Z pkt)) (res (handle-exceptions exn #f (server-ready? host port key)))) (if res res (let* ((pktsdir (get-pkts-dir *toppath*)) (pktpath (conc pktsdir"/"pktz".pkt"))) (debug:print 0 *default-log-port* "WARNING: pkt with no server "pktpath) (delete-file* pktpath) #f)))) serv-pkts)) ;; from viable servers get one that is alive and ready ;; (define (get-the-server apath serv-pkts) (let loop ((tail serv-pkts)) (if (null? tail) #f |
︙ | ︙ | |||
2003 2004 2005 2006 2007 2008 2009 | (get-host-name) (servdat-port sdat) server-key (servdat-host sdat) db-file)) ;; (set! *my-signature* (servdat-uuid sdat)) ;; replace with Z, no, stick with proper key ;; now read pkts and see if we are a contender (let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*)) (viables (get-viable-servers all-pkts db-file)) | > | | > > > > > > > | | | > | < < | 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 | (get-host-name) (servdat-port sdat) server-key (servdat-host sdat) db-file)) ;; (set! *my-signature* (servdat-uuid sdat)) ;; replace with Z, no, stick with proper key ;; now read pkts and see if we are a contender (let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*)) (viables (get-viable-servers all-pkts db-file)) (alive (remove-pkts-if-not-alive viables)) (best-srv (get-best-candidate alive db-file)) (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)) (i-am-srv (equal? best-srv-key server-key)) (delete-pkt (lambda () (let* ((pktfile (conc (get-pkts-dir *toppath*) "/" (servdat-uuid *server-info*) ".pkt"))) (debug:print-info 0 *default-log-port* "Attempting to remove bogus pkt file "pktfile) (delete-file* pktfile))))) ;; remove immediately instead of waiting for on-exit (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key", i-am-srv: "i-am-srv) ;; am I the best-srv, compare server-keys to know (if i-am-srv (if (get-lock-db sdat db-file (servdat-port sdat)) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id) (begin (debug:print 0 *default-log-port* "I'm the server!") (servdat-dbfile-set! sdat db-file) (servdat-status-set! sdat 'db-locked)) (begin (debug:print 0 *default-log-port* "I'm not the server, exiting.") (bdat-time-to-exit-set! *bdat* #t) (delete-pkt) (thread-sleep! 0.2) (exit))) (begin (debug:print 0 *default-log-port* "Keys do not match "best-srv-key", "server-key", exiting.") (bdat-time-to-exit-set! *bdat* #t) (delete-pkt) (thread-sleep! 0.2) (exit))) sdat)) (begin ;; sdat not yet contains server info (debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat) (sleep 4) (if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes |
︙ | ︙ |
Modified stml2.scm from [6f0ee137b2] to [c7394e5219].
︙ | ︙ | |||
16 17 18 19 20 21 22 23 24 25 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit stml2)) (declare (uses cookie)) (include "stml2/stml2.scm") | > > | 16 17 18 19 20 21 22 23 24 25 26 27 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit stml2)) (declare (uses cookie)) (declare (uses dbi)) (declare (uses autoload)) (include "stml2/stml2.scm") |
Modified stml2/formdat.scm from [f4b16c20f8] to [0f3102ec8c].
︙ | ︙ | |||
8 9 10 11 12 13 14 | ;; PURPOSE. ;; (declare (unit formdat)) (module formdat * | | < | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 | ;; PURPOSE. ;; (declare (unit formdat)) (module formdat * (import chicken scheme data-structures extras srfi-13 ports html-filter) (import regex) (import srfi-69) ) |
Modified stml2/html-filter.scm from [55ec64cff2] to [a2ae004691].
︙ | ︙ | |||
9 10 11 12 13 14 15 | ;; (declare (unit html-filter)) (module html-filter * (import chicken scheme data-structures extras srfi-13 ports ) | | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 | ;; (declare (unit html-filter)) (module html-filter * (import chicken scheme data-structures extras srfi-13 ports ) (import misc-stml) (import regex) ;; ) |
Modified stml2/misc-stml.scm from [30ba5d90bf] to [8660d67355].
︙ | ︙ | |||
14 15 16 17 18 19 20 | ;; (declare (unit misc-stml)) (module misc-stml * (import chicken scheme data-structures extras srfi-13 ports posix) | | | < | 14 15 16 17 18 19 20 21 22 23 | ;; (declare (unit misc-stml)) (module misc-stml * (import chicken scheme data-structures extras srfi-13 ports posix) (import regex (prefix dbi dbi:)) (import (prefix crypt c:)) ) |
Modified stml2/rollup-pages.scm from [b24bc2e231] to [37b97898ac].
|
| | | 1 2 3 4 5 6 7 8 | (import regex posix srfi-69 srfi-1) (define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm")) (define (print-page-wrapper lookup page) (print "(define (pages:" page " session db shared)") (if (hash-table-ref/default lookup (conc page "_ctrl") #f) (print "(include \"pages/" page "_ctrl.scm\")")) |
︙ | ︙ |
Modified stml2/session.scm from [300e7014a0] to [32b68ce58f].
︙ | ︙ | |||
9 10 11 12 13 14 15 | ;; (declare (unit session)) (module session * (import chicken scheme data-structures extras srfi-13 ports posix files srfi-1) | | < | | 9 10 11 12 13 14 15 16 17 18 19 | ;; (declare (unit session)) (module session * (import chicken scheme data-structures extras srfi-13 ports posix files srfi-1) (import (prefix dbi dbi:) srfi-69 regex) (import cookie stmlcommon) ;; (declare (uses cookie)) ) |
Modified stml2/setup.scm from [27fec5f813] to [6248624979].
1 2 3 4 5 6 7 8 9 10 11 12 13 | ;; Copyright 2007-2011, 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. (module setup * (import chicken scheme data-structures extras srfi-13 ports posix) | | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | ;; Copyright 2007-2011, 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. (module setup * (import chicken scheme data-structures extras srfi-13 ports posix) (import session misc-stml) ;; (declare (unit setup))se ;; (declare (uses session)) (import srfi-69 regex) ) |
Modified stml2/spiffyserver.scm from [0953505b2d] to [36a130548d].
1 2 | ;; This doesn't work yet ;; | | | 1 2 3 4 5 6 7 8 9 10 | ;; This doesn't work yet ;; (import spiffy cgi-handler) (spiffy-debug-mode #t) (spiffy-file-ext-handlers `(("drcdb" . ,(cgi-handler* "/path/to/drcdb")))) (spiffy-root-path "/path/to/web") |
︙ | ︙ |
Modified stml2/sqlite3.scm from [935dbe7787] to [b0bb736749].
1 2 3 4 5 6 7 8 9 10 11 12 13 | ;; Copyright 2007-2011, 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. ;; ;; I used this to get a simple interactive sqlite editor on the nokia n800 ;; since I couldn't get sqlite3 to install (for reasons I can't remember). | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | ;; Copyright 2007-2011, 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. ;; ;; I used this to get a simple interactive sqlite editor on the nokia n800 ;; since I couldn't get sqlite3 to install (for reasons I can't remember). (import sqlite3) (define args (argv)) (define num-args (length args)) (define dbname #f) (define cmd #f) |
︙ | ︙ |
Modified stml2/stmlcommon.scm from [d0639f2742] to [ba756fc30d].
︙ | ︙ | |||
11 12 13 14 15 16 17 | ;; (declare (run-time-macros)) (module stmlcommon * (import chicken scheme data-structures extras srfi-13 ports posix) | | | 11 12 13 14 15 16 17 18 19 20 | ;; (declare (run-time-macros)) (module stmlcommon * (import chicken scheme data-structures extras srfi-13 ports posix) (import (prefix dbi dbi:) regex (prefix crypt c:) srfi-69) ) |
Modified stml2/stmlrun.scm from [a5be661fee] to [4939b15c7b].
︙ | ︙ | |||
9 10 11 12 13 14 15 | ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; (require-extension syntax-case) ;; (declare (run-time-macros)) ;; (include "stmlcommon.scm") | | | 9 10 11 12 13 14 15 16 17 18 19 | ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; (require-extension syntax-case) ;; (declare (run-time-macros)) ;; (include "stmlcommon.scm") (import stml) (stml:main #f) |
Modified stml2/test.scm from [62a996e095] to [6d65a60d4d].
|
| | < | 1 2 3 4 5 6 7 8 9 | (import test md5) (import (prefix sqlite3 sqlite3:)) (require-library dbi) ;; (declare (uses stml)) (include "requirements.scm") |
︙ | ︙ |
Modified testsmod.scm from [13d6172d0b] to [1d551a945a].
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses itemsmod)) (declare (uses rmtmod)) (declare (uses stml2)) (declare (uses dbmod)) (declare (uses tasksmod)) (module testsmod * (import scheme chicken.base | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | (declare (uses commonmod)) (declare (uses configfmod)) (declare (uses itemsmod)) (declare (uses rmtmod)) (declare (uses stml2)) (declare (uses dbmod)) (declare (uses tasksmod)) (declare (uses dbi)) (module testsmod * (import scheme chicken.base |
︙ | ︙ |