@@ -135,26 +135,26 @@ (lambda (db) ;;(debug:print 0 *default-log-port* "calling proc " proc " on db " db) (set-busy-handler! db (busy-timeout 10000)) ;; 10 sec timeout (if (not dbexists)(sretrieve:initialize-db db)) (proc db))))) - (debug:print 0 *default-log-port* "ERROR: invalid path for storing database: " path)))) + (debug:print-error 0 *default-log-port* "invalid path for storing database: " path)))) ;; copy in directory 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 *default-log-port* "ERROR: Bad configuration! base-dir " base-dir " not found") + (debug:print-error 0 *default-log-port* "Bad configuration! base-dir " base-dir " not found") (exit 1))) (print datadir) (if (not (file-exists? datadir)) (begin - (debug:print 0 *default-log-port* "ERROR: Bad version (" version "), no data found at " datadir "." ) + (debug:print-error 0 *default-log-port* "Bad version (" version "), no data found at " datadir "." ) (exit 1))) (sretrieve:db-do configdat (lambda (db) @@ -187,24 +187,24 @@ (datadir (conc base-dir "/" file)) (filename (conc(pathname-file datadir) "." (pathname-extension datadir)))) (if (or (not base-dir) (not (file-exists? base-dir))) (begin - (debug:print 0 *default-log-port* "ERROR: Bad configuration! base-dir " base-dir " not found") + (debug:print-error 0 *default-log-port* "Bad configuration! base-dir " base-dir " not found") (exit 1))) (print datadir) (if (not (file-exists? datadir)) (begin - (debug:print 0 *default-log-port* "ERROR: File (" file "), not found at " base-dir "." ) + (debug:print-error 0 *default-log-port* "File (" file "), not found at " base-dir "." ) (exit 1))) (if (directory? datadir) (begin - (debug:print 0 *default-log-port* "ERROR: (" file ") is a dirctory!! cp cmd works only on files ." ) + (debug:print-error 0 *default-log-port* "(" file ") is a dirctory!! cp cmd works only on files ." ) (exit 1))) (if(not (string-match (regexp allowed-sub-paths) file)) (begin - (debug:print 0 *default-log-port* "ERROR: Access denied to file (" file ")!! " ) + (debug:print-error 0 *default-log-port* "Access denied to file (" file ")!! " ) (exit 1))) (sretrieve:db-do configdat (lambda (db) @@ -224,20 +224,20 @@ (datadir (conc base-dir "/" file)) (filename (conc(pathname-file datadir) "." (pathname-extension datadir)))) (if (or (not base-dir) (not (file-exists? base-dir))) (begin - (debug:print 0 *default-log-port* "ERROR: Bad configuration! base-dir " base-dir " not found") + (debug:print-error 0 *default-log-port* "Bad configuration! base-dir " base-dir " not found") (exit 1))) (print datadir) (if (not (file-exists? datadir)) (begin - (debug:print 0 *default-log-port* "ERROR: File (" file "), not found at " base-dir "." ) + (debug:print-error 0 *default-log-port* "File (" file "), not found at " base-dir "." ) (exit 1))) (if(not (string-match (regexp allowed-sub-paths) file)) (begin - (debug:print 0 *default-log-port* "ERROR: Access denied to file (" file ")!! " ) + (debug:print-error 0 *default-log-port* "Access denied to file (" file ")!! " ) (exit 1))) (sretrieve:do-as-calling-user (lambda () ;;(change-directory datadir) @@ -256,16 +256,16 @@ (define (sretrieve:validate target-dir targ-mk) (let* ((normal-path (normalize-pathname targ-mk)) (targ-path (conc target-dir "/" normal-path))) (if (string-contains normal-path "..") (begin - (debug:print 0 *default-log-port* "ERROR: Path " targ-mk " resolved outside target area " target-dir ) + (debug:print-error 0 *default-log-port* "Path " targ-mk " resolved outside target area " target-dir ) (exit 1))) (if (not (string-contains targ-path target-dir)) (begin - (debug:print 0 *default-log-port* "ERROR: You cannot update data outside " target-dir ".") + (debug:print-error 0 *default-log-port* "You cannot update data outside " target-dir ".") (exit 1))) (debug:print 0 *default-log-port* "Path " targ-mk " is valid.") )) ;; make directory in dest ;; @@ -273,11 +273,11 @@ (define (sretrieve:mkdir configdat submitter target-dir targ-mk comment) (let ((targ-path (conc target-dir "/" targ-mk))) (if (file-exists? targ-path) (begin - (debug:print 0 *default-log-port* "ERROR: target Directory " targ-path " already exist!!") + (debug:print-error 0 *default-log-port* "target Directory " targ-path " already exist!!") (exit 1))) (sretrieve:db-do configdat (lambda (db) (sretrieve:register-action db "mkdir" submitter targ-mk comment))) @@ -303,15 +303,15 @@ ;; (define (sretrieve:ln configdat submitter target-dir targ-link link-name comment) (let ((targ-path (conc target-dir "/" link-name))) (if (file-exists? targ-path) (begin - (debug:print 0 *default-log-port* "ERROR: target file " targ-path " already exist!!") + (debug:print-error 0 *default-log-port* "target file " targ-path " already exist!!") (exit 1))) (if (not (file-exists? targ-link )) (begin - (debug:print 0 *default-log-port* "ERROR: target file " targ-link " does not exist!!") + (debug:print-error 0 *default-log-port* "target file " targ-link " does not exist!!") (exit 1))) (sretrieve:db-do configdat (lambda (db) @@ -339,11 +339,11 @@ ;; (define (sretrieve:rm configdat submitter target-dir targ-file comment) (let ((targ-path (conc target-dir "/" targ-file))) (if (not (file-exists? targ-path)) (begin - (debug:print 0 *default-log-port* "ERROR: target file " targ-path " not found, nothing to remove.") + (debug:print-error 0 *default-log-port* "target file " targ-path " not found, nothing to remove.") (exit 1))) (sretrieve:db-do configdat (lambda (db) (sretrieve:register-action db "rm" submitter targ-file comment))) @@ -487,11 +487,11 @@ (if (file-exists? upstream-file) (if (or (not (file-exists? package-config)) ;; if not created call the updater, otherwise call only if upstream newer (> (file-modification-time upstream-file)(file-modification-time package-config))) (handle-exceptions exn - (debug:print 0 *default-log-port* "ERROR: failed to run script " conversion-script " with params " upstream-file " " package-config) + (debug:print-error 0 *default-log-port* "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 *default-log-port* "Skipping update of " package-config " from " upstream-file)) (debug:print 0 *default-log-port* "Skipping update of " package-config " as " upstream-file " not found")) ;; (ini:property-separator-patt " * *") @@ -527,11 +527,11 @@ (exit 1))) (case (string->symbol action) ((get) (if (< (length args) 1) (begin - (debug:print 0 *default-log-port* "ERROR: Missing arguments; " (string-intersperse args ", ")) + (debug:print-error 0 *default-log-port* "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") @@ -542,11 +542,11 @@ (debug:print 0 *default-log-port* "retrieving " version " of " package-type " as tar data on stdout") (sretrieve:get configdat user version msg))) ((cp) (if (< (length args) 1) (begin - (debug:print 0 *default-log-port* "ERROR: Missing arguments; " (string-intersperse args ", ")) + (debug:print-error 0 *default-log-port* "Missing arguments; " (string-intersperse args ", ")) (exit 1))) (let* ((remargs (args:get-args args '("-m" "-i" "-package") '() args:arg-hash 0)) (file (car args)) (msg (or (args:get-arg "-m") "")) ) @@ -553,11 +553,11 @@ (debug:print 0 *default-log-port* "copinging " file " to current directory " ) (sretrieve:cp configdat user file msg))) ((ls) (if (< (length args) 1) (begin - (debug:print 0 *default-log-port* "ERROR: Missing arguments; " (string-intersperse args ", ")) + (debug:print-error 0 *default-log-port* "Missing arguments; " (string-intersperse args ", ")) (exit 1))) (let* ((remargs (args:get-args args '("-m" "-i" "-package") '() args:arg-hash 0)) (dir (car args)) (msg (or (args:get-arg "-m") "")) ) @@ -612,8 +612,8 @@ (print "ERROR: Unrecognised command. Try \"sretrieve help\"")))) ;; multi-word commands ((null? rema)(print sretrieve:help)) ((>= (length rema) 2) (apply sretrieve:process-action configdat (car rema)(cdr rema))) - (else (debug:print 0 *default-log-port* "ERROR: Unrecognised command. Try \"sretrieve help\""))))) + (else (debug:print-error 0 *default-log-port* "Unrecognised command. Try \"sretrieve help\""))))) (main)