Megatest

Check-in [9355c8264d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Cleaned up dependencies on sretrieve
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 9355c8264d22e528495880a8199cf890e8dccdb8
User & Date: matt on 2016-01-31 23:33:52
Other Links: branch diff | manifest | tags
Context
2016-02-01
16:54
Added static and PROXY to Makefile for sretrieve check-in: 6be112f8aa user: mrwellan tags: v1.60
2016-01-31
23:33
Cleaned up dependencies on sretrieve check-in: 9355c8264d user: matt tags: v1.60
2016-01-27
10:35
Merged fork check-in: ae9052fa69 user: mrwellan tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [c0b2515300] to [b3cdbad9b2].

︙
213
214
215
216
217
218
219
220
221










222
223
224
225
226
227
228

213
214
215
216
217
218
219


220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236








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









xterm : sd
	(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)

datashare-testing/spublish : spublish.scm $(OFILES)
	csc spublish.scm $(OFILES) -o datashare-testing/spublish

datashare-testing/sretrieve : sretrieve.scm $(OFILES)
	csc sretrieve.scm $(OFILES) -o datashare-testing/sretrieve
datashare-testing/sretrieve : sretrieve.scm common.o megatest-version.o margs.o configf.o
	csc sretrieve.scm common.o megatest-version.o margs.o configf.o -o datashare-testing/sretrieve

sretrieve/sretrieve : datashare-testing/sretrieve
	csc -deploy sretrieve.scm megatest-version.o margs.o configf.o
	chicken-install -deploy -prefix sretrieve defstruct srfi-18 format sql-de-lite \
             srfi-1 posix regex regex-case srfi-69

# base64 dot-locking \
#             csv-xml z3

#  "(define (toplevel-command . a) #f)"
readline-fix.scm :
	if egrep 'version.*3.0' $(shell dirname $(shell dirname $(shell which csi)))/lib/chicken/7/readline.setup-info;then \
           echo "(use-legacy-bindings)" > readline-fix.scm; \
	else \
	   echo "" > readline-fix.scm;\
︙

Modified common.scm from [83d9632595] to [b57ee1d8e2].

︙
419
420
421
422
423
424
425








426
427
428
429
430
431
432

419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440








+
+
+
+
+
+
+
+








   (or configf (read-config "megatest.config" #f #t))
   "disks" '("none" "")))

;;======================================================================
;; T A R G E T S  ,   S T A T E ,   S T A T U S ,   
;;                    R U N N A M E    A N D   T E S T P A T T
;;======================================================================

;; Lookup a value in runconfigs based on -reqtarg or -target
(define (runconfigs-get config var)
  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
    (if targ
	(or (configf:lookup config targ var)
	    (configf:lookup config "default" var))
	(configf:lookup config "default" var))))

(define (common:args-get-state)
  (or (args:get-arg "-state")(args:get-arg ":state")))

(define (common:args-get-status)
  (or (args:get-arg "-status")(args:get-arg ":status")))
︙

Modified configf.scm from [6f6eea6687] to [1e6b64ea69].

︙
9
10
11
12
13
14
15
16

17
18
19

20
21
22
23
24
25
26

9
10
11
12
13
14
15

16
17


18
19
20
21
22
23
24
25








-
+

-
-
+








;;  PURPOSE.
;;======================================================================

;;======================================================================
;; Config file handling
;;======================================================================

(use regex regex-case directory-utils)
(use regex regex-case) ;;  directory-utils)
(declare (unit configf))
(declare (uses common))
(declare (uses process))
;; (declare (uses process))

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))
︙
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

131
132
133
134
135
136
137








138
139
140
141
142
143
144








-
-
-
-
-
-
-
-








	  outres)
	(begin
	  (with-output-to-port (current-error-port)
	    (lambda ()
	      (print "ERROR: " cmd " returned bad exit code " status)))
	  ""))))

;; Lookup a value in runconfigs based on -reqtarg or -target
(define (runconfigs-get config var)
  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
    (if targ
	(or (configf:lookup config targ var)
	    (configf:lookup config "default" var))
	(configf:lookup config "default" var))))

;; this was inline but I'm pretty sure that is a hold over from when it was *very* simple ...
;;
(define (configf:read-line p ht allow-processing settings)
  (let loop ((inl (read-line p)))
    (let ((cont-line (and (string? inl)
			  (not (string-null? inl))
			  (equal? "\\" (string-take-right inl 1)))))
︙

Modified datashare-testing/.sretrieve.config from [9987501f48] to [f5fc49272d]. 

1
2
3

4
5
6
7
8

1
2

3
4
5
6
7
8



-
+






[settings]
base-dir      /tmp/delme_data
allowed-users matt mrwellan pjhatwal
allowed-users matt
allowed-chars [0-9a-zA-Z\-\.]+

[database]
location #{scheme (create-directory "/tmp/#{getenv USER}" #t)}

Modified launch.scm from [a8ea94019f] to [f6a535adf3].

︙
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032
1033
1034

1020
1021
1022
1023
1024
1025
1026

1027
1028
1029
1030
1031
1032
1033
1034








-
+








					  (list "MT_TARGET"    mt_target)
					  (list "MT_ITEMPATH"  item-path)
					  )
				    itemdat)))
	   ;; Launchwait defaults to true, must override it to turn off wait
	   (launchwait     (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t))
	   (launch-results (apply (if launchwait
				      cmd-run-with-stderr->list
				      process:cmd-run-with-stderr->list
				      process-run)
				  (if useshell
				      (let ((cmdstr (string-intersperse fullcmd " ")))
					(if launchwait
					    cmdstr
					    (conc cmdstr " >> mt_launch.log 2>&1")))
				      (car fullcmd))
︙

Modified margs.scm from [5bb81571cb] to [c9007a2ca1]. 

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18











-
+








;; Copyright 2007-2010, 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.

(declare (unit margs))
(declare (uses common))
;; (declare (uses common))

(define args:arg-hash (make-hash-table))

(define (args:get-arg arg . default)
  (if (null? default)
      (hash-table-ref/default args:arg-hash arg #f)
      (hash-table-ref/default args:arg-hash arg (car default))))
︙

Modified process.scm from [785bc2c6db] to [a74a40a846].

︙
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

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








-
+




-
-
+
+












-
+








;; Process convience utils
;;======================================================================

(use regex)
(declare (unit process))
(declare (uses common))

(define (conservative-read port)
(define (process:conservative-read port)
  (let loop ((res ""))
    (if (not (eof-object? (peek-char port)))
	(loop (conc res (read-char port)))
	res)))
    
(define (cmd-run-with-stderr->list cmd . params)

(define (process:cmd-run-with-stderr->list cmd . params)
  ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
;;  (handle-exceptions
;;   exn
;;   (begin
;;     (print "ERROR:  Failed to run command: " cmd " " (string-intersperse params " "))
;;     (print "       " ((condition-property-accessor 'exn 'message) exn))
;;     #f)
   (let-values (((fh fho pid fhe) (if (null? params)
				      (process* cmd)
				      (process* cmd params))))
       (let loop ((curr (read-line fh))
		  (result  '()))
	 (let ((errstr (conservative-read fhe)))
	 (let ((errstr (process:conservative-read fhe)))
	   (if (not (string=? errstr ""))
	       (set! result (append result (list errstr)))))
       (if (not (eof-object? curr))
	   (loop (read-line fh)
		 (append result (list curr)))
	   (begin
	     (close-input-port fh)
︙

Modified spublish.scm from [d9dd46dab2] to [9e76c7e82b].

︙
18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33

18
19
20
21
22
23
24


25
26
27
28
29
30
31
32
33








-
-
+
+








;; (use regex-case)
;; (use posix)
;; (use json)
;; (use csv)
(use srfi-18)
(use format)

(require-library ini-file)
(import (prefix ini-file ini:))
;; (require-library ini-file)
;; (import (prefix ini-file ini:))

(use sql-de-lite srfi-1 posix regex regex-case srfi-69)
;; (import (prefix sqlite3 sqlite3:))
;; 
(declare (uses configf))
;; (declare (uses tree))
(declare (uses margs))
︙
348
349
350
351
352
353
354
355
356


357
358
359
360
361
362
363

348
349
350
351
352
353
354


355
356
357
358
359
360
361
362
363








-
-
+
+









;;======================================================================
;; MAIN
;;======================================================================

(define (spublish:load-config exe-dir exe-name)
  (let* ((fname   (conc exe-dir "/." exe-name ".config")))
    (ini:property-separator-patt " *  *")
    (ini:property-separator #\space)
    ;; (ini:property-separator-patt " *  *")
    ;; (ini:property-separator #\space)
    (if (file-exists? fname)
	;; (ini:read-ini fname)
	(read-config fname #f #t)
	(make-hash-table))))

(define (spublish:process-action configdat action . args)
  (let* ((target-dir    (configf:lookup configdat "settings" "target-dir"))
︙

Modified sretrieve.scm from [7a2e55c6ff] to [8380ec9aed].

︙
15
16
17
18
19
20
21
22

23
24
25
26
27


28
29
30
31
32
33
34

15
16
17
18
19
20
21

22
23
24
25


26
27
28
29
30
31
32
33
34








-
+



-
-
+
+








;; (use sxml-modifications)
;; (use regex)
;; (use srfi-69)
;; (use regex-case)
;; (use posix)
;; (use json)
;; (use csv)
(use directory-utils)
;; (use directory-utils)
(use srfi-18)
(use format)

(require-library ini-file)
(import (prefix ini-file ini:))
;; (require-library ini-file)
;; (import (prefix ini-file ini:))

(use sql-de-lite srfi-1 posix regex regex-case srfi-69)
;; (import (prefix sqlite3 sqlite3:))
;; 
(declare (uses configf))
;; (declare (uses tree))
(declare (uses margs))
︙
42
43
44
45
46
47
48



49
50
51
52
53
54
55

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58








+
+
+








;; (declare (uses tbd))

(include "megatest-fossil-hash.scm")

;;
;; GLOBALS
;;
(define *verbosity* 1)
(define *logging* #f)

(define *sretrieve:current-tab-number* 0)
(define *args-hash* (make-hash-table))
(define sretrieve:help (conc "Usage: sretrieve [action [params ...]]

  ls                     : list contents of target area
  get <relversion>       : retrieve data for release <version>
    -m \"message\"       : why retrieved?
︙
321
322
323
324
325
326
327
328
329


330
331
332
333
334
335
336

324
325
326
327
328
329
330


331
332
333
334
335
336
337
338
339








-
-
+
+









;;======================================================================
;; MAIN
;;======================================================================

(define (sretrieve:load-config exe-dir exe-name)
  (let* ((fname   (conc exe-dir "/." exe-name ".config")))
    (ini:property-separator-patt " *  *")
    (ini:property-separator #\space)
    ;; (ini:property-separator-patt " *  *")
    ;; (ini:property-separator #\space)
    (if (file-exists? fname)
	;; (ini:read-ini fname)
	(read-config fname #f #t)
	(make-hash-table))))

;; package-type is "megatest", "builds", "kits" etc.
;;
︙
349
350
351
352
353
354
355
356
357


358
359
360
361
362
363
364

352
353
354
355
356
357
358


359
360
361
362
363
364
365
366
367








-
-
+
+








	    (handle-exceptions
	     exn
	     (debug:print 0 "ERROR: failed to run script " conversion-script " with params " upstream-file " " package-config)
	     (let ((pid (process-run conversion-script (list upstream-file package-config))))
	       (process-wait pid)))
	    (debug:print 0 "Skipping update of " package-config " from " upstream-file))
	(debug:print 0 "Skipping update of " package-config " as " upstream-file " not found"))
    (ini:property-separator-patt " *  *")
    (ini:property-separator #\space)
    ;; (ini:property-separator-patt " *  *")
    ;; (ini:property-separator #\space)
    (let ((res (if (file-exists? package-config)
		   (begin
		     (debug:print 0 "Reading package config " package-config)
		     (read-config package-config #f #t))
		   (make-hash-table))))
      (pop-directory)
      res)))
︙

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