| ︙ | | |
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
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 <version> : retrieve data for <version>
get <relversion> : retrieve data for release <version>
-i iteration_num get specific iteration
|
| ︙ | | |
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
|
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 reldat retriever area version iter comment)
(define (sretrieve:get configdat retriever version 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)))
(debug:print 0 "ERROR: Bad version (" version ") or iteration (" iteration "), no data found at " datadir "." )
(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
|
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 (or (configf:lookup configdat "settings" "packages-metadir")
(let* ((packages-metadir (configf:lookup configdat "settings" "packages-metadir"))
".")) ;; exe-dir))
|
| ︙ | | |
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
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") ""))
(iteration (args:get-arg "-i"))
(exe-dir (configf:lookup configdat "exe-info" "exe-dir"))
(relconfig (sretrieve:load-packages configdat exe-dir package-type)))
(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)))
(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
|
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 ((target-dir (configf:lookup configdat "settings" "target-dir")))
(print "Files in " target-dir)
(system (conc "ls " target-dir))))
(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")))))
|
| ︙ | | |