512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
(begin
(debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.")
(debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (print-call-chain (current-error-port)) ;;
)
(let* ((fullname (conc "logs/" file))
(mod-time (file-modification-time fullname))
(file-age (- (current-seconds) mod-time)))
(hash-table-set! all-files file mod-time)
(if (or (and (string-match "^.*.log" file)
(> (file-size fullname) 200000))
(and (string-match "^server-.*.log" file)
(> (- (current-seconds) (file-modification-time fullname))
(* 8 60 60))))
(if (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
(handle-exceptions
exn
#f
(if (directory? fullname)
(begin
(debug:print-error 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
(inc-stat "directories"))
|
|
>
>
|
>
<
|
|
>
|
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
|
(begin
(debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore.")
(debug:print 2 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (print-call-chain (current-error-port)) ;;
)
(let* ((fullname (conc "logs/" file))
(mod-time (file-modification-time fullname))
(file-age (- (current-seconds) mod-time))
(file-old (> file-age (* 48 60 60)))
(file-big (> (file-size fullname) 200000)))
(hash-table-set! all-files file mod-time)
(if (or (and (string-match "^.*.log" file)
file-old
file-big)
(and (string-match "^server-.*.log" file)
file-old))
(let ((gzfile (conc fullname ".gz")))
(if (common:file-exists? gzfile)
(begin
(debug:print-info 0 *default-log-port* "removing " gzfile)
(delete-file* gzfile)
(hash-table-delete! all-files gzfile) ;; needed?
))
(debug:print-info 0 *default-log-port* "compressing " file)
(system (conc "gzip " fullname))
(inc-stat "gzipped")
(hash-table-set! all-files (conc file ".gz") file-age) ;; add the .gz file and remove the base file
(hash-table-delete! all-files file)
)
(if (and (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
(file-exists? fullname)) ;; just in case it was gzipped - will get it next time
(handle-exceptions
exn
#f
(if (directory? fullname)
(begin
(debug:print-error 0 *default-log-port* fullname " in logs directory is a directory! Cannot rotate it, it is best to not put subdirectories in the logs dir.")
(inc-stat "directories"))
|
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
|
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(cmod:get-testsuite-name *toppath* *configdat*))
;; safe getting of toppath
(define (common:get-toppath areapath)
(or *toppath*
(if areapath
(begin
(set! *toppath* areapath)
|
>
>
>
|
>
>
|
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
|
(if val val default)))
(define (assoc/default key lst . default)
(let ((res (assoc key lst)))
(if res (cadr res)(if (null? default) #f (car default)))))
(define (common:get-testsuite-name)
(or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
(configf:lookup *configdat* "setup" "testsuite" )
(getenv "MT_TESTSUITE_NAME")
(if (string? *toppath* )
(pathname-file *toppath*)
#f))) ;; (pathname-file (current-directory)))))
;; safe getting of toppath
(define (common:get-toppath areapath)
(or *toppath*
(if areapath
(begin
(set! *toppath* areapath)
|
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
|
(if (> curr-rownum rownum) curr-rownum rownum)
(if (> curr-colnum colnum) curr-colnum colnum)
))))))
;; if it looks like a number -> convert it to a number, else return it
;;
(define (common:lazy-convert inval)
(cmod:lazy-convert inval))
;; convert string a=1; b=2; c=a silly thing; d=
;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;;
(define (common:val->alist val #!key (convert #f))
(cmod:val->alist val #!key (convert #f)))
|
>
|
>
>
>
>
>
>
>
>
|
>
>
>
|
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
|
(if (> curr-rownum rownum) curr-rownum rownum)
(if (> curr-colnum colnum) curr-colnum colnum)
))))))
;; if it looks like a number -> convert it to a number, else return it
;;
(define (common:lazy-convert inval)
(let* ((as-num (if (string? inval)(string->number inval) #f)))
(or as-num inval)))
;; convert string a=1; b=2; c=a silly thing; d=
;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
;;
(define (common:val->alist val #!key (convert #f))
(let ((val-list (string-split-fields ";\\s*" val #:infix)))
(if val-list
(map (lambda (x)
(let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
(case (length f)
((0) `(,#f)) ;; null string case
((1) `(,(string->symbol (car f))))
((2) `(,(string->symbol (car f)) . ,(let ((inval (cadr f)))
(if convert (common:lazy-convert inval) inval))))
(else f))))
val-list)
'())))
;;======================================================================
;; S Y S T E M S T U F F
;;======================================================================
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;;
|