Megatest

Diff
Login

Differences From Artifact [3f1c95a0fd]:

To Artifact [7a2e55c6ff]:


47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
;; GLOBALS
;;
(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 <version>          : retrieve data for <version>
    -i iteration_num       get specific iteration
    -m \"message\"       : why retrieved?

  log                    : get listing of recent downloads

Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest








|
<







47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
;; GLOBALS
;;
(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?

  log                    : get listing of recent downloads

Part of the Megatest tool suite.
Learn more at http://www.kiatoa.com/fossils/megatest

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
	      (set-busy-handler! db (busy-timeout 10000)) ;; 10 sec timeout
	      (if (not dbexists)(sretrieve:initialize-db db))
	      (proc db)))))
	(debug:print 0 "ERROR: invalid path for storing database: " path))))

;; copy in file to dest, validation is done BEFORE calling this
;;
(define (sretrieve:get configdat reldat retriever area version iter comment)
  (let* ((iteration (or iter
			(configf:lookup reldat version "iteration")))
	 (base-dir  (configf:lookup configdat "settings" "base-dir"))
	 (datadir   (conc base-dir "/" area "/" version "/" iteration)))
    (if (or (not base-dir)
	    (not (file-exists? base-dir)))
	(begin
	  (debug:print 0 "ERROR: Bad configuration! base-dir " base-dir " not found")
	  (exit 1)))
    (print datadir)
    (if (not (file-exists? datadir))
	(begin
	  (debug:print 0 "ERROR: Bad version (" version ") or iteration (" iteration "), no data found at " datadir "." )
	  (exit 1)))
    
    (sretrieve:db-do
     configdat
     (lambda (db)
       (sretrieve:register-action db "get" retriever datadir comment)))
    (change-directory datadir)







|
<
<
|
|








|







130
131
132
133
134
135
136
137


138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
	      (set-busy-handler! db (busy-timeout 10000)) ;; 10 sec timeout
	      (if (not dbexists)(sretrieve:initialize-db db))
	      (proc db)))))
	(debug:print 0 "ERROR: invalid path for storing database: " path))))

;; copy in file to dest, validation is done BEFORE calling this
;;
(define (sretrieve:get configdat retriever version comment)


  (let* ((base-dir  (configf:lookup configdat "settings" "base-dir"))
	 (datadir   (conc base-dir "/" version)))
    (if (or (not base-dir)
	    (not (file-exists? base-dir)))
	(begin
	  (debug:print 0 "ERROR: Bad configuration! base-dir " base-dir " not found")
	  (exit 1)))
    (print datadir)
    (if (not (file-exists? datadir))
	(begin
	  (debug:print 0 "ERROR: Bad version (" version "), no data found at " datadir "." )
	  (exit 1)))
    
    (sretrieve:db-do
     configdat
     (lambda (db)
       (sretrieve:register-action db "get" retriever datadir comment)))
    (change-directory datadir)
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
	(read-config fname #f #t)
	(make-hash-table))))

;; package-type is "megatest", "builds", "kits" etc.
;;
(define (sretrieve:load-packages configdat exe-dir package-type)
  (push-directory exe-dir)
  (let* ((packages-metadir  (or (configf:lookup configdat "settings" "packages-metadir")
				".")) ;; exe-dir))
	 (conversion-script (configf:lookup configdat "settings" "conversion-script"))
	 (upstream-file     (configf:lookup configdat "settings" "upstream-file"))
	 (package-config    (conc packages-metadir "/" package-type ".config")))
    ;; this section here does a timestamp based rebuild of the
    ;;   <packages-metadir>/<package-type>.config file using
    ;;   <upstream-file> as an input
    (if (file-exists? upstream-file)







|
<







332
333
334
335
336
337
338
339

340
341
342
343
344
345
346
	(read-config fname #f #t)
	(make-hash-table))))

;; package-type is "megatest", "builds", "kits" etc.
;;
(define (sretrieve:load-packages configdat exe-dir package-type)
  (push-directory exe-dir)
  (let* ((packages-metadir  (configf:lookup configdat "settings" "packages-metadir"))

	 (conversion-script (configf:lookup configdat "settings" "conversion-script"))
	 (upstream-file     (configf:lookup configdat "settings" "upstream-file"))
	 (package-config    (conc packages-metadir "/" package-type ".config")))
    ;; this section here does a timestamp based rebuild of the
    ;;   <packages-metadir>/<package-type>.config file using
    ;;   <upstream-file> as an input
    (if (file-exists? upstream-file)
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
       (if (< (length args) 1)
	   (begin 
	     (debug:print 0 "ERROR: Missing arguments; " (string-intersperse args ", "))
	     (exit 1)))
       (let* ((remargs     (args:get-args args '("-m" "-i" "-package") '() args:arg-hash 0))
              (version     (car args))
	      (msg         (or (args:get-arg "-m") ""))
	      (iteration   (args:get-arg "-i"))
	      (package-type (or (args:get-arg "-package")
				default-area))
	      (exe-dir     (configf:lookup configdat "exe-info" "exe-dir"))
	      (relconfig   (sretrieve:load-packages configdat exe-dir package-type)))

	 (debug:print 0 "retrieving " version " of " package-type " as tar data on stdout")
	 (sretrieve:get configdat relconfig user package-type version iteration msg)))
      (else (debug:print 0 "Unrecognised command " action)))))
  
;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
;; (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.sretrieverc")))
;;   (if (file-exists? debugcontrolf)
;;       (load debugcontrolf)))








<


|
|


|







388
389
390
391
392
393
394

395
396
397
398
399
400
401
402
403
404
405
406
407
408
       (if (< (length args) 1)
	   (begin 
	     (debug:print 0 "ERROR: Missing arguments; " (string-intersperse args ", "))
	     (exit 1)))
       (let* ((remargs     (args:get-args args '("-m" "-i" "-package") '() args:arg-hash 0))
              (version     (car args))
	      (msg         (or (args:get-arg "-m") ""))

	      (package-type (or (args:get-arg "-package")
				default-area))
	      (exe-dir     (configf:lookup configdat "exe-info" "exe-dir")))
;;	      (relconfig   (sretrieve:load-packages configdat exe-dir package-type)))

	 (debug:print 0 "retrieving " version " of " package-type " as tar data on stdout")
	 (sretrieve:get configdat user version msg)))
      (else (debug:print 0 "Unrecognised command " action)))))
  
;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
;; (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.sretrieverc")))
;;   (if (file-exists? debugcontrolf)
;;       (load debugcontrolf)))

427
428
429
430
431
432
433
434


435
436

437
438
439
440
441
442
443
     ((eq? (length rema) 1)
      (case (string->symbol (car rema))
	((help -h -help --h --help)
	 (print sretrieve:help))
	((list-vars) ;; print out the ini file
	 (map print (sretrieve:get-areas configdat)))
	((ls)
	 (let ((target-dir (configf:lookup configdat "settings" "target-dir")))


	   (print "Files in " target-dir)
	   (system (conc "ls " target-dir))))

	((log)
	 (sretrieve:db-do configdat (lambda (db)
				     (print "Listing actions")
				     (query (for-each-row
					     (lambda (row)
					       (apply print (intersperse row " | "))))
					    (sql db "SELECT * FROM actions")))))







|
>
>
|
|
>







422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
     ((eq? (length rema) 1)
      (case (string->symbol (car rema))
	((help -h -help --h --help)
	 (print sretrieve:help))
	((list-vars) ;; print out the ini file
	 (map print (sretrieve:get-areas configdat)))
	((ls)
	 (let* ((base-dir (configf:lookup configdat "settings" "base-dir")))
	   (if base-dir
	       (begin
		 (print "Files in " base-dir)
		 (system (conc "ls " base-dir)))
	       (print "ERROR: No base dir specified!"))))
	((log)
	 (sretrieve:db-do configdat (lambda (db)
				     (print "Listing actions")
				     (query (for-each-row
					     (lambda (row)
					       (apply print (intersperse row " | "))))
					    (sql db "SELECT * FROM actions")))))