Megatest

Check-in [38a3940f9b]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Getting still closer but not there yet
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-ck5
Files: files | file ages | folders
SHA1: 38a3940f9b931d48167af860d36780abc89336aa
User & Date: matt on 2021-04-06 22:53:22
Other Links: branch diff | manifest | tags
Context
2021-04-07
08:51
wip check-in: 4e134398af user: matt tags: v1.6584-ck5
2021-04-06
22:53
Getting still closer but not there yet check-in: 38a3940f9b user: matt tags: v1.6584-ck5
13:51
Wip, getting close ... check-in: b4e9092089 user: matt tags: v1.6584-ck5
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [eb444dcd26] to [d1e874e844].

︙
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

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








+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
+

-
-
-
+
+
+
+
+









# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
# rm <files>.o ; make install CSCOPTS='-profile' ; ... ;  chicken-profile | less
SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES =

SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm	\
           server.scm configf.scm db.scm keys.scm margs.scm		\
           process.scm runs.scm tasks.scm tests.scm genexample.scm	\
           http-transport.scm filedb.scm tdb.scm client.scm mt.scm	\
           ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm		\
           subrun.scm portlogger.scm archive.scm env.scm		\
           diff-report.scm cgisetup/models/pgdb.scm
# common.scm items.scm launch.scm ods.scm runconfig.scm	\
#            server.scm configf.scm db.scm keys.scm margs.scm		\
#            process.scm runs.scm tasks.scm tests.scm genexample.scm	\
#            http-transport.scm filedb.scm tdb.scm client.scm mt.scm	\
#            ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm		\
#            subrun.scm portlogger.scm archive.scm env.scm		\
#            diff-report.scm cgisetup/models/pgdb.scm

# module source files
MSRCFILES = 
# MSRCFILES = 
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm
MSRCFILES = autoload.scm dbi.scm ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
            mtargs.scm

# commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#            rmtmod.scm apimod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\
          vg.scm

OFILES   = $(SRCFILES:%.scm=%.o)
GOFILES  = $(GUISRCF:%.scm=%.o)
︙
57
58
59
60
61
62
63




64
65
66
67
68
69
70

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78








+
+
+
+








#	cp $*.o mofiles/$*.o
#	@touch $*.import.scm # ensure it is touched after the .o is made

mofiles/%.o : %.scm
	mkdir -p mofiles
	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o

# module dependencies
mofiles/stml2.o : mofiles/dbi.o
mofiles/dbi.o   : mofiles/autoload.o

ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')

ifeq ($(MTESTHASH),)
$(error MTESTHASH is broken!)
︙

Added altdb-template.scm version [805de76f5f]. 





1
2
3

+
+
+

;; optional alternate db setup
(define *available-db* (make-hash-table))
(import postgresql)(hash-table-set! *available-db* 'postgresql #t)








Added autoload.scm version [2b9f0c7a0d].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

;;======================================================================
;; Copyright 2019, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     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 autoload))

(include "autoload/autoload.scm")








Added dbi.scm version [3f996117f2].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

;;======================================================================
;; Copyright 2019, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     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")








Modified http-transport.scm
from [73ceea083e]
to [11f0936b19].




︙


38
39
40
41
42
43
44
45

46
47
48
49
50
51
52

38
39
40
41
42
43
44

45
46
47
48
49
50
51
52








-
+








;; (declare (uses portlogger))
;; (declare (uses rmt))
;; 
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "js-path.scm")

(require-library stml)
;; (require-library stml)
(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define *server-loop-heart-beat* (current-seconds))





︙







Modified megatest.scm
from [be2a53addb]
to [0f4170fd94].




︙


12
13
14
15
16
17
18




19
20
21
22
23
24






25
26

27
28








29
30
31
32
33
34
35

12
13
14
15
16
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








+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

-
+


+
+
+
+
+
+
+
+








;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;;  megatest.scm mofiles/autoload.o mofiles/dbi.o mofiles/ducttape-lib.o
;;  mofiles/pkts.o mofiles/stml2.o mofiles/cookie.o mofiles/mutils.o
;;  mofiles/mtargs.o

(include "mutils/mutils.scm")
(include "autoload/autoload.scm")
(include "dbi/dbi.scm")
(include "stml2/cookie.scm")
(include "stml2/stml2.scm")
(include "pkts/pkts.scm")
;; (include "mutils/mutils.scm")
;; (include "autoload/autoload.scm")
;; (include "dbi/dbi.scm")
;; (include "stml2/cookie.scm")
;; (include "stml2/stml2.scm")
;; (include "pkts/pkts.scm")
(include "csv-xml/csv-xml.scm")
(include "ducttape/ducttape-lib.scm")
;; (include "ducttape/ducttape-lib.scm")
(include "hostinfo/hostinfo.scm")
(include "adjutant.scm")

(declare (uses mutils))
(declare (uses autoload))
(declare (uses pkts))
(declare (uses ducttape-lib))
(declare (uses stml2))
(declare (uses cookie))
(declare (uses mtargs))

;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module megatest-main
	*

	(import scheme




︙


74
75
76
77
78
79
80






81

82
83
84
85
86
87
88

86
87
88
89
90
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106








+
+
+
+
+
+
-
+








		typed-records
		s11n
		sparse-vectors
		sxml-serializer
		sxml-modifications
		system-information
		z3
		spiffy
		uri-common
		intarweb
		http-client
		spiffy-request-vars
		intarweb
		spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing
		spiffy-directory-listing
		
		srfi-1
		srfi-4
		srfi-18
		srfi-13
		srfi-98
		srfi-69




︙







Modified mtargs/mtargs.scm
from [e2f1c247b7]
to [40b7a0d6eb].




︙


24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39

24
25
26
27
28
29
30

31

32
33
34
35
36
37
38








-
+
-








     usage
     get-args
     print-args
     any-defined?
     help
     )

(import scheme chicken data-structures extras posix ports files)
(import scheme chicken.base chicken.process-context srfi-69 srfi-1)
(use 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)




︙







Added pktsmod.scm version [4f496b5684].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

;;======================================================================
;; Copyright 2019, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     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 pkts))

(include "pkts/pkts.scm")








Modified stml2.scm
from [63b057818a]
to [47f316ad28].




︙


17
18
19
20
21
22
23





17
18
19
20
21
22
23
24
25
26
27








+
+
+
+

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit stml2))

(include "stml2/stml2.scm")

(import stml2)

(write "true")








Modified stml2/stml2.scm
from [44fdf7437b]
to [ccb26a2824].




︙


10
11
12
13
14
15
16
17

18

















19
20








21
22
23

24
25
26
27
28
29
30

10
11
12
13
14
15
16

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








-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+

-
-
+








;; stml is a list of html strings

;; (declare (unit stml))

(module stml2
    *

(import (chicken random) (chicken base) (chicken string) (chicken time) scheme queues srfi-13 (chicken port) (chicken io) (chicken file) srfi-69 srfi-1 (chicken condition) (chicken time posix) (chicken process-context posix) (chicken pathname) (chicken blob) (chicken format) (chicken process) (chicken process-context)) 
  (import

    (chicken base)
    (chicken blob)
    (chicken condition)
    (chicken file)
    (chicken format)
    (chicken io)
    (chicken pathname)
    (chicken port)
    (chicken process)
    (chicken process-context posix)
    (chicken process-context)
    (chicken random)
    (chicken string)
    (chicken time posix)
    (chicken time)
    (prefix crypt c:)
    (prefix dbi dbi:)
(import cookie)
(import (prefix dbi dbi:) (prefix crypt c:) typed-records)
    cookie
    queues
    regex
    scheme
    srfi-1
    srfi-13
    srfi-69
    typed-records

;; (declare (uses misc-stml))
(import regex)
    )

;; The (usually global) sdat contains everything about the session
;;
(defstruct sdat
  ;; database
  (dbtype 'pg)
  (dbinit #f)




︙


730
731
732
733
734
735
736
737
738


739
740
741
742
743
744
745

752
753
754
755
756
757
758


759
760
761
762
763
764
765
766
767








-
-
+
+








   ((string? val)  (string->number val))
   ((symbol? val)  (string->number (symbol->string val)))
   (else     #f)))

;; NB// this is *illegal* pgint
(define (s:illegal-pgint val)
  (cond
   ((> val 2147483647) 1)
   ((< val -2147483648) -1)
   ((> val 2147483640.0) 1)   ;;  2147483647
   ((< val -2147483640.0) -1) ;; -2147483648
   (else #f)))

(define (s:any->pgint val)
  (let ((n (s:any->number val)))
    (if n
	(if (s:illegal-pgint n)
	    #f




︙


1103
1104
1105
1106
1107
1108
1109
1110

1111
1112
1113

1114
1115

1116
1117
1118
1119
1120
1121
1122

1125
1126
1127
1128
1129
1130
1131

1132
1133
1134

1135
1136

1137
1138
1139
1140
1141
1142
1143
1144








-
+


-
+

-
+








	(formdat:load-all-port (current-input-port))
	(make-formdat:formdat))))

;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
  (let* ((formdat        (make-formdat:formdat))
	 (debugp         #f))
			 ;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
    ;; (open-output-file (conc "/tmp/delme-" (current-user-id) ".log"))))
    ;; (write-string (read-string #f inp) #f debugp)  ;; destroys all data!
    (formdat:initialize formdat)
    (let ((alldats (formdat:dat->list inp 10e6 debug-port: debugp)))
    (let ((alldats (formdat:dat->list inp 10e6 debug-port: #f debugp)))
      
      (if debugp (format debugp "formdat : alldats: ~A\n" alldats))
      #;(if debugp (format debugp "formdat : alldats: ~A\n" alldats))

      (let ((firstitem   (car alldats))
	    (multipass #f)) 
	(if (and (not (null? firstitem))
		 (not (null? (car firstitem))))
	    (if (string-match formdat:delim-patt-rex (caar firstitem))
		(set! multipass #t)))




︙


1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162

1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
1184








-
+








	    ;; 		       (munged (s:process-cgi-input datstr)))
	    ;; 		  (print "datstr: " datstr " munged: " munged)
	    (if (and (not (null? alldats))
		     (not (null? (car alldats)))
		     (not (null? (caar alldats))))
		(formdat:load formdat  (s:process-cgi-input (caaar alldats))))) ;; munged))
	;;		    (format debugp "formdat : name: ~A content: ~A\n" name content)
	(if debugp (close-output-port debugp))
	#;(if debugp (close-output-port debugp))
	;; (sdat-formdat-set! s:session formdat)
	formdat))))
		
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))




︙












This page was generated in about
0.11s by
Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00