Megatest

Changes On Branch sauth-testing-chicken5
Login

Changes In Branch sauth-testing-chicken5 Excluding Merge-Ins

This is equivalent to a diff from b129805ac8 to 0af9864a95

2019-07-12
15:12
Changed login failed to login unsuccessfull check-in: f7a5f0b8f1 user: mrwellan tags: v1.65
2019-07-09
10:54
added new table for run tags check-in: 0be89c389a user: pjhatwal tags: v1.65
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
2019-06-18
17:09
Merged in choosesync branch check-in: f3be772e6c user: mrwellan tags: v1.65

Modified sauth-common.scm from [28ffd8e69e] to [29d676d589].

238
239
240
241
242
243
244










245
246
247
248
249
250
251
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
284

285
286
287
288
289
290
291
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 "Access denied to " (string-join resolved-path "/"))
                              (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
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)
717
718
719
720
721
722
723
724

725
726
727
728
729
730
731

732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747
748
749
750
722
723
724
725
726
727
728

729
730
731
732
733
734
735

736
737
738
739
740
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755







-
+






-
+











-
+







			      (read-line))))
	      (msg         (or (args:get-arg "-m") ""))
              (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; <area> <path>")
	     (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") ""))
               (resolved-path (sauth-common:resolve-path  mk-path (list area) top-areas))
               (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) 
        (if (< (length remargs) 2)
          (begin