Overview
| Comment: | sauth update |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | sauth-testing-chicken5 |
| Files: | files | file ages | folders |
| SHA1: |
0af9864a9574ee64b1217e0a383255ef |
| User & Date: | pjhatwal on 2019-06-21 11:37:33 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-06-21
| ||
| 11:37 | sauth update Leaf check-in: 0af9864a95 user: pjhatwal tags: sauth-testing-chicken5 | |
|
2019-06-19
| ||
| 10:49 | Changed the word failed to unable in message to aleviate need to add logpro rule check-in: b129805ac8 user: mrwellan tags: v1.65 | |
Changes
Modified sauth-common.scm from [28ffd8e69e] to [29d676d589].
| ︙ | ︙ | |||
238 239 240 241 242 243 244 245 246 247 248 249 250 251 |
(sauthorize:db-do (lambda (db)
(let* ((data-row (query fetch (sql db (conc "SELECT code, exe_name, id, basepath FROM areas where areas.code = '" code "'")))))
(set! obj data-row))))
;(print obj)
obj))
;; 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)
(let* ((target-path (append current (string-split new "/")))
(target-path-string (string-join target-path "/"))
| > > > > > > > > > > | 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 |
(sauthorize:db-do (lambda (db)
(let* ((data-row (query fetch (sql db (conc "SELECT code, exe_name, id, basepath FROM areas where areas.code = '" code "'")))))
(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)
(let* ((target-path (append current (string-split new "/")))
(target-path-string (string-join target-path "/"))
|
| ︙ | ︙ | |||
277 278 279 280 281 282 283 |
base-path
(conc base-path "/" (string-join (cdr resolved-path) "/")))))
(if (and (not (equal? restricted-areas "" ))
(string-match (regexp restrictions) target-path))
(begin
| | | 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 |
base-path
(conc base-path "/" (string-join (cdr resolved-path) "/")))))
(if (and (not (equal? restricted-areas "" ))
(string-match (regexp restrictions) target-path))
(begin
(sauth:print-error (conc "Access denied to " (string-join resolved-path "/")))
;(exit 1)
#f)
target-path)
))
#f)))
|
| ︙ | ︙ |
Modified spublish.scm from [f88672550b] to [f826faecc2].
| ︙ | ︙ | |||
391 392 393 394 395 396 397 398 399 400 401 402 403 404 |
(define (spublish:shell-cp src-path target-path)
(cond
((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 (is_directory src-path)
(begin
(let* ((parent-dir src-path)
(start-dir target-path))
(run (pipe
(begin (system (conc "cd " parent-dir " ;tar chf - ." )))
(begin (change-directory start-dir)
| > > > > > | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 |
(define (spublish:shell-cp src-path target-path)
(cond
((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
(begin (system (conc "cd " parent-dir " ;tar chf - ." )))
(begin (change-directory start-dir)
|
| ︙ | ︙ |