Changes In Branch v1.70-refactor02-chicken5 Through [b772abfc70] Excluding Merge-Ins
This is equivalent to a diff from 850872189d to b772abfc70
2020-01-04
| ||
16:45 | Pulled in compilation fixes from refactor02. check-in: 337a4b27f1 user: matt tags: v1.70-captain-ulex, v1.70-defunct-try | |
2020-01-02
| ||
15:40 | Initial load of needed eggs into fossil check-in: e6be7bbc9f user: jmoon18 tags: v1.70-refactor02-chicken5, v1.70-defunct-try | |
15:39 | Additional tweaks to enable chicken 5 check-in: b772abfc70 user: jmoon18 tags: v1.70-refactor02-chicken5, v1.70-defunct-try | |
13:56 | Initial commit towards supporting chicken 5 in megatest check-in: 65df38ba3d user: jmoon18 tags: v1.70-refactor02-chicken5, v1.70-defunct-try | |
09:36 | Fixed imports so dashboard launches Leaf check-in: 850872189d user: jmoon18 tags: v1.70-refactor02, v1.70-defunct-try | |
2019-12-31
| ||
16:19 | Added runsmod to eval-string in megatest.scm check-in: 269f41c0b0 user: mrwellan tags: v1.70-refactor02, v1.70-defunct-try | |
Modified archivemod.scm from [4dfe611770] to [874489c882].
︙ | ︙ | |||
20 21 22 23 24 25 26 | (declare (unit archivemod)) (declare (uses commonmod)) (module archivemod * | | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (declare (unit archivemod)) (declare (uses commonmod)) (module archivemod * (import scheme (chicken base)) (import (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 format (chicken port) srfi-1 matchable) (import commonmod) ;; (use (prefix ulex ulex:)) (include "common_records.scm") ) |
Modified clientmod.scm from [449944fa84] to [f47d133940].
︙ | ︙ | |||
20 21 22 23 24 25 26 | (declare (unit clientmod)) (declare (uses commonmod)) (module clientmod * | | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (declare (unit clientmod)) (declare (uses commonmod)) (module clientmod * (import scheme (chicken base)) (import (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 format (chicken port) srfi-1 matchable) (import commonmod) ;; (use (prefix ulex ulex:)) (include "common_records.scm") ) |
Modified common_records.scm from [5084b8d608] to [2591541cd3].
︙ | ︙ | |||
15 16 17 18 19 20 21 | ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; ;;====================================================================== ;; (use trace) | | | 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/>. ;; ;;====================================================================== ;; (use trace) (import typed-records) ;; moved to commonmod |
Modified envmod.scm from [322fc41dfe] to [a2ad9fe426].
︙ | ︙ | |||
20 21 22 23 24 25 26 | (declare (unit envmod)) (declare (uses commonmod)) (module envmod * | | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (declare (unit envmod)) (declare (uses commonmod)) (module envmod * (import scheme (chicken base)) (import (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 format (chicken port) srfi-1 matchable) (import commonmod) ;; (use (prefix ulex ulex:)) (include "common_records.scm") ) |
Modified ezstepsmod.scm from [b506cc05b8] to [bb1c5c176e].
︙ | ︙ | |||
20 21 22 23 24 25 26 | (declare (unit ezstepsmod)) (declare (uses commonmod)) (module ezstepsmod * | | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (declare (unit ezstepsmod)) (declare (uses commonmod)) (module ezstepsmod * (import scheme (chicken base)) (import (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 format (chicken port) srfi-1 matchable) (import commonmod) ;; (use (prefix ulex ulex:)) (include "common_records.scm") ) |
Modified itemsmod.scm from [fc849e85b2] to [ca44098a8e].
︙ | ︙ | |||
21 22 23 24 25 26 27 | (declare (unit itemsmod)) (declare (uses commonmod)) (declare (uses mtconfigf)) (module itemsmod * | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | (declare (unit itemsmod)) (declare (uses commonmod)) (declare (uses mtconfigf)) (module itemsmod * (import scheme (chicken base)) (import (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 format (chicken port) srfi-1 matchable) (import commonmod) (import(prefix mtconfigf configf:)) ;; (use (prefix ulex ulex:)) ;; (include "common_records.scm") ;; (include "items-inc.scm") |
︙ | ︙ |
Modified mtargs/mtargs.scm from [e2f1c247b7] to [a907d8beb0].
︙ | ︙ | |||
24 25 26 27 28 29 30 | usage get-args print-args any-defined? help ) | | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | usage get-args print-args any-defined? help ) (import scheme (chicken base) (chicken port) (chicken file) (chicken process-context)) (import srfi-69 srfi-1) (define arg-hash (make-hash-table)) (define help "") (define (get-arg arg . default) (if (null? default) (hash-table-ref/default arg-hash arg #f) |
︙ | ︙ |
Modified mtconfigf/mtconfigf.scm from [f14586a434] to [1f14c46c82].
︙ | ︙ | |||
69 70 71 72 73 74 75 | get-eval-string squelch-debug-prints ;; misc realpath find-chicken-lib ) | | | | | > | | | | | | | | | | | 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 102 103 104 105 106 107 108 109 110 111 112 113 | get-eval-string squelch-debug-prints ;; misc realpath find-chicken-lib ) (import scheme (chicken base) (chicken string) (chicken file) (chicken port)) (import typed-records srfi-18 pathname-expand) (import regex regex-case srfi-69 srfi-1 directory-utils srfi-13 ) (import (chicken io) (chicken condition) (chicken process-context)) (import (chicken process) (chicken pathname) (chicken pretty-print) (chicken time)) (import srfi-69 (chicken platform) (chicken sort)) ;; stub debug printers overridden by set-debug-printers (define (debug:print n e . args) (apply print args)) (define (debug:print-info n e . args) (apply print "INFO: " args)) (define (debug:print-error n e . args) (apply print "ERROR: " args)) ;;(import (prefix mtdebug debug:)) ;;(define args:any? args:any-defined?) ;; cannot name it any? in mtargs module ;; FROM common.scm ;; ;; this plugs a hole in posix-extras in recent chicken versions > 4.9) ;;;(let-values (( (chicken-release-number chicken-major-version) ;;; (apply values ;;; (map string->number ;;; (take ;;; (string-split (chicken-version) ".") ;;; 2))))) ;;; (if (or (> chicken-release-number 4) ;;; (and (eq? 4 chicken-release-number) (> chicken-major-version 9))) ;;; (define ##sys#expand-home-path pathname-expand))) ;;(define (set-verbosity v)(debug:set-verbosity v)) (define *default-log-port* (current-error-port)) (define (debug:print-error n . args) ;;; n available to end-users but ignored for |
︙ | ︙ | |||
214 215 216 217 218 219 220 | (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables. (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"") (if (and (string? val) (string? key)) (handle-exceptions exn (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val) | | | | | | | 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables. (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"") (if (and (string? val) (string? key)) (handle-exceptions exn (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val) (set-environment-variable! key val)) (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)))) ;; accept an alist or hash table containing envvar/env value pairs (value of #f causes unset) ;; execute thunk in context of environment modified as per this list ;; restore env to prior state then return value of eval'd thunk. ;; ** this is not thread safe ** (define (with-env-vars delta-env-alist-or-hash-table thunk) (let* ((delta-env-alist (if (hash-table? delta-env-alist-or-hash-table) (hash-table->alist delta-env-alist-or-hash-table) delta-env-alist-or-hash-table)) (restore-thunks (filter identity (map (lambda (env-pair) (let* ((env-var (car env-pair)) (new-val (let ((tmp (cdr env-pair))) (if (list? tmp) (car tmp) tmp))) (current-val (get-environment-variable env-var)) (restore-thunk (cond ((not current-val) (lambda () (unset-environment-variable! env-var))) ((not (string? new-val)) #f) ((eq? current-val new-val) #f) (else (lambda () (set-environment-variable! env-var current-val)))))) ;;(when (not (string? new-val)) ;; (debug:print 0 *default-log-port* " PROBLEM: not a string: "new-val"\n from env-alist:\n"delta-env-alist) ;; (pp delta-env-alist) ;; (exit 1)) (cond ((not new-val) ;; modify env here (unset-environment-variable! env-var)) ((string? new-val) (set-environment-variable! env-var new-val))) restore-thunk)) delta-env-alist)))) (let ((rv (thunk))) (for-each (lambda (x) (x)) restore-thunks) ;; restore env to original state rv))) (define (cmd-run->list cmd #!key (delta-env-alist-or-hash-table '())) |
︙ | ︙ | |||
681 682 683 684 685 686 687 | (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))) (configf:script-rx ( x include-script params);; handle-exceptions ;; exn ;; (begin ;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.") ;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) | | | 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 | (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))) (configf:script-rx ( x include-script params);; handle-exceptions ;; exn ;; (begin ;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.") ;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f)) (if (and (safe-file-exists? include-script)(file-executable? include-script)) (let* ((local-allow-system (calc-allow-system allow-system curr-section-name sections)) (env-delta (cfgdat->env-alist curr-section-name res local-allow-system)) (new-inp-port (with-env-vars env-delta (lambda () (open-input-pipe (conc include-script " " params)))))) |
︙ | ︙ | |||
817 818 819 820 821 822 823 | ;; (define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)(set-fields #f)(keep-filenames #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname toppath: given-toppath)) (toppath (car configinfo)) (configfile (cadr configinfo))) (if toppath (change-directory toppath)) | | | 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 | ;; (define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)(set-fields #f)(keep-filenames #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname toppath: given-toppath)) (toppath (car configinfo)) (configfile (cadr configinfo))) (if toppath (change-directory toppath)) (if (and toppath pathenvvar)(set-environment-variable! pathenvvar toppath)) (let ((configdat (if configfile (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (if set-fields (list (cons "^fields$" set-fields) ) '()) #f keep-filenames: keep-filenames)))) (if toppath (change-directory curr-dir)) (list configdat toppath configfile fname)))) |
︙ | ︙ | |||
1049 1050 1051 1052 1053 1054 1055 | ;; reads a refdb into an assoc array of assoc arrays ;; returns (list dat msg) (define (read-refdb refdb-path) (let ((sheets-file (conc refdb-path "/sheet-names.cfg"))) (if (not (safe-file-exists? sheets-file)) (list #f (conc "ERROR: no refdb found at " refdb-path)) | | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 | ;; reads a refdb into an assoc array of assoc arrays ;; returns (list dat msg) (define (read-refdb refdb-path) (let ((sheets-file (conc refdb-path "/sheet-names.cfg"))) (if (not (safe-file-exists? sheets-file)) (list #f (conc "ERROR: no refdb found at " refdb-path)) (if (not (file-readable? sheets-file)) (list #f (conc "ERROR: refdb file not readable at " refdb-path)) (let* ((sheets (with-input-from-file sheets-file (lambda () (let loop ((inl (read-line)) (res '())) (if (eof-object? inl) (reverse res) |
︙ | ︙ |
Modified odsmod.scm from [f8aba8b41f] to [bb53b8595f].
︙ | ︙ | |||
20 21 22 23 24 25 26 | (declare (unit odsmod)) (declare (uses commonmod)) (module odsmod * | | | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | (declare (unit odsmod)) (declare (uses commonmod)) (module odsmod * (import scheme (chicken base) (chicken string) (chicken port) (chicken io) (chicken file) csv-xml regex) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable srfi-13) (import commonmod) ;; (use (prefix ulex ulex:)) (define ods:dirs '("Configurations2" |
︙ | ︙ |
Modified pkts/pkts.scm from [d1cd1cb6f6] to [55a662356c].
︙ | ︙ | |||
160 161 162 163 164 165 166 | pktdb-pktspec ;; utility procs increment-string ;; used to get indexes for strings in ref pkts make-report ;; make a .dot file ) | > | | | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | pktdb-pktspec ;; utility procs increment-string ;; used to get indexes for strings in ref pkts make-report ;; make a .dot file ) (import (chicken base) scheme (chicken process) (chicken time posix) (chicken io) (chicken file)) (import chicken.process-context.posix (chicken string) (chicken time) (chicken sort) (chicken file posix) (chicken condition) srfi-1 regex srfi-13 srfi-69 (chicken port) ) (import crypt sha1 message-digest (prefix dbi dbi:) typed-records) ;;====================================================================== ;; DATA MANIPULATION UTILS ;;====================================================================== (define-inline (unescape-data data) (string-translate* data '(("\\n" . "\n") ("\\\\" . "\\")))) |
︙ | ︙ |
Modified stml2/cookie.scm from [d78a525a3a] to [fba413a4c8].
︙ | ︙ | |||
43 44 45 46 47 48 49 | ;; <http://www.netscape.com/newsref/std/cookie_spec.html> ;; (declare (unit cookie)) (module cookie * | | | 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | ;; <http://www.netscape.com/newsref/std/cookie_spec.html> ;; (declare (unit cookie)) (module cookie * (import (chicken base) scheme queues srfi-13 (chicken port) (chicken io)(chicken file) (chicken format) (chicken string) (chicken time posix)) (require-extension srfi-1 srfi-13 srfi-14 regex) ;; (use srfi-1 srfi-13 srfi-14 regex) ;; (declare (export parse-cookie-string construct-cookie-string)) ;; #> ;; #include <time.h> |
︙ | ︙ |
Modified stml2/stml2.scm from [ee4c13898d] to [3dca2d569e].
︙ | ︙ | |||
10 11 12 13 14 15 16 | ;; stml is a list of html strings ;; (declare (unit stml)) (module stml2 * | | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | ;; stml is a list of html strings ;; (declare (unit stml)) (module stml2 * (import (chicken base) scheme queues srfi-13 (chicken port) (chicken io) (chicken file) srfi-69 srfi-1 (chicken condition)) (import cookie) (import (prefix dbi dbi:) (prefix crypt c:) typed-records) ;; (declare (uses misc-stml)) (use regex) ;; The (usually global) sdat contains everything about the session ;; (defstruct sdat |
︙ | ︙ |
Modified ulex/ulex.scm from [ef093072a2] to [1e0838dba7].
︙ | ︙ | |||
56 57 58 59 60 61 62 | ;; pl-is-port-available ;; pl-get-port-state ;; ;; system ;; get-normalized-cpu-load ;; ) | | | | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ;; pl-is-port-available ;; pl-get-port-state ;; ;; system ;; get-normalized-cpu-load ;; ) (import scheme posix-groups (chicken base) queues (chicken port) (chicken io) (chicken file) mailbox) (import srfi-18 pkts matchable regex typed-records srfi-69 srfi-1 srfi-4 regex-case (prefix sqlite3 sqlite3:) foreign tcp) ;; ulex-netutil) ;;====================================================================== |
︙ | ︙ |