︙ | | | ︙ | |
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(include "megatest-fossil-hash.scm")
(require-library stml)
(define *target-mappers* (make-hash-table)) ;; '())
(define *runname-mappers* (make-hash-table)) ;; '())
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
;; this needs some thought regarding security implications.
;;
;; i. Check that owner of the file and calling user are same?
;; ii. Check that we are in a legal megatest area?
;; iii. Have some form of authentication or record of the md5sum or similar of the file?
;; iv. Use compiled version in preference to .scm version. Thus there is a manual "blessing"
;; required to use .mtutil.scm.
|
<
<
<
<
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
(include "megatest-fossil-hash.scm")
(require-library stml)
(define *target-mappers* (make-hash-table)) ;; '())
(define *runname-mappers* (make-hash-table)) ;; '())
;; this needs some thought regarding security implications.
;;
;; i. Check that owner of the file and calling user are same?
;; ii. Check that we are in a legal megatest area?
;; iii. Have some form of authentication or record of the md5sum or similar of the file?
;; iv. Use compiled version in preference to .scm version. Thus there is a manual "blessing"
;; required to use .mtutil.scm.
|
︙ | | | ︙ | |
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
|
;;
(define (command-line->pkt action args-alist sched-in)
(let* ((sched (cond
((vector? sched-in)(local-time->seconds sched-in)) ;; we recieved a time
((number? sched-in) sched-in)
(else (current-seconds))))
(args-data (if args-alist
args-alist
(hash-table->alist args:arg-hash))) ;; if no args-alist then we assume this is a call driven directly by commandline
(alldat (apply append (list 'T "cmd"
'a action
'U (current-user-name)
'D sched)
(map (lambda (x)
(let* ((param (car x))
|
>
>
|
|
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
;;
(define (command-line->pkt action args-alist sched-in)
(let* ((sched (cond
((vector? sched-in)(local-time->seconds sched-in)) ;; we recieved a time
((number? sched-in) sched-in)
(else (current-seconds))))
(args-data (if args-alist
(if (hash-table? args-alist) ;; seriously?
(hash-table->alist args-alist)
args-alist)
(hash-table->alist args:arg-hash))) ;; if no args-alist then we assume this is a call driven directly by commandline
(alldat (apply append (list 'T "cmd"
'a action
'U (current-user-name)
'D sched)
(map (lambda (x)
(let* ((param (car x))
|
︙ | | | ︙ | |
881
882
883
884
885
886
887
888
889
890
891
892
893
894
|
pkts))))))
(define (get-pkts-dir mtconf)
(let ((pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
(pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f)))
pktsdir))
(if *action*
(case (string->symbol *action*)
((run remove rerun set-ss archive kill)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
(pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f))
|
>
>
>
>
|
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
|
pkts))))))
(define (get-pkts-dir mtconf)
(let ((pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
(pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f)))
pktsdir))
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(if *action*
(case (string->symbol *action*)
((run remove rerun set-ss archive kill)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
(pktsdir (if pktsdirs (car (string-split pktsdirs " ")) #f))
|
︙ | | | ︙ | |
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
|
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
(if (get-environment-variable "HTTP_HOST")
(begin
(stml:main #f)
(exit)))
(if (or (args:get-arg "-repl")
(args:get-arg "-load"))
(begin
(import extras) ;; might not be needed
;; (import csi)
(import readline)
|
<
|
937
938
939
940
941
942
943
944
945
946
947
948
949
950
|
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
(if (get-environment-variable "HTTP_HOST")
(begin
(stml:main #f)
(exit)))
(if (or (args:get-arg "-repl")
(args:get-arg "-load"))
(begin
(import extras) ;; might not be needed
;; (import csi)
(import readline)
|
︙ | | | ︙ | |