Index: sauth-common.scm ================================================================== --- sauth-common.scm +++ sauth-common.scm @@ -240,10 +240,20 @@ (set! obj data-row)))) ;(print obj) obj)) +(define (sauth-common:src-size path) + (let ((output (with-input-from-pipe (conc "/usr/bin/du -s " path " | awk '{print $1}'") + (lambda() + (read-line))))) + (string->number output))) + +(define (sauth-common:space-left-at-dest path) + (let* ((output (run/string (pipe (df ,path ) (tail -1)))) + (size (caddr (string-split output " ")))) + (string->number size))) ;; function to validate the users input for target path and resolve the path ;; TODO: Check for restriction in subpath (define (sauth-common:resolve-path new current allowed-sheets) @@ -279,11 +289,11 @@ (if (and (not (equal? restricted-areas "" )) (string-match (regexp restrictions) target-path)) (begin - (sauth:print-error "Access denied to " (string-join resolved-path "/")) + (sauth:print-error (conc "Access denied to " (string-join resolved-path "/"))) ;(exit 1) #f) target-path) )) Index: spublish.scm ================================================================== --- spublish.scm +++ spublish.scm @@ -393,10 +393,15 @@ ((not (file-exists? target-path)) (sauth:print-error (conc " target Directory " target-path " does not exist!!"))) ((not (file-exists? src-path)) (sauth:print-error (conc "Source path " src-path " does not exist!!" ))) (else + (if (< (sauth-common:space-left-at-dest target-path) (sauth-common:src-size src-path)) + (begin + (sauth:print-error "Error: Destination does not have enough disk space.") + (exit 1))) + (if (is_directory src-path) (begin (let* ((parent-dir src-path) (start-dir target-path)) (run (pipe @@ -719,18 +724,18 @@ (resolved-path (sauth-common:resolve-path (conc area "/" dest-path) `() top-areas)) (target-path (sauth-common:get-target-path `() (conc area "/" dest-path) top-areas base-path))) (if (not (equal? target-path #f)) (if (equal? resolved-path #f) (print "Invalid argument " dest-path ".. ") - (begin + (begin (spublish:shell-cp src-path target-path) (sauthorize:do-as-calling-user (lambda () (run-cmd (conc *sauth-path* "/sauthorize") (list "register-log" (conc "\" cp " src-path-in " " dest-path "\"") (number->string (car user-obj)) (number->string (caddr area-obj)) "cp"))))))))) ((mkdir) (if (< (length remargs) 1) - (begin + (begin (print "ERROR: Missing arguments; ") (exit 1))) (let* ((filter-args (args:get-args args '("-m") '() args:arg-hash 0)) (mk-path (car filter-args)) (msg (or (args:get-arg "-m") "")) @@ -738,11 +743,11 @@ (target-path (sauth-common:get-target-path (list area) mk-path top-areas base-path))) (print "attempting to create directory " mk-path ) (if (not (equal? target-path #f)) (if (equal? resolved-path #f) (print "Invalid argument " mk-path ".. ") - (begin + (begin (spublish:shell-mkdir target-path) (sauthorize:do-as-calling-user (lambda () (run-cmd (conc *sauth-path* "/sauthorize") (list "register-log" (conc "\" mkdir " mk-path "\"") (number->string (car user-obj)) (number->string (caddr area-obj)) "mkdir"))))))))) ((ln)