Megatest

Check-in [ffb3fa86c6]
Login
Overview
Comment:Improved logs rotation to disallow more than 300 logs (configurable) in the logs dir.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: ffb3fa86c6fd6939f728d06b404414cfd9ef55d5
User & Date: matt on 2019-09-26 23:06:42
Other Links: branch diff | manifest | tags
Context
2019-09-30
11:50
Added commonmod.scm check-in: 84f39d59fb user: mrwellan tags: v1.65, v1.6535, v1.6536
2019-09-27
11:19
Sync with v1.65 check-in: b767764b1a user: mrwellan tags: v1.65-wip
2019-09-26
23:06
Improved logs rotation to disallow more than 300 logs (configurable) in the logs dir. check-in: ffb3fa86c6 user: matt tags: v1.65
2019-09-25
16:38
Merged in the first pass code clean up using modules. This passes unit and ext-tests. check-in: 0d84db9635 user: mrwellan tags: v1.65
Changes

Modified common.scm from [e8a2323473] to [8cb8136193].

471
472
473
474
475
476
477





478
479
480
481
482

483


484
485


486
487
488
489
490
491
492
493
494
495


496
497




498
499
500
501
502


503
504













505
506
507
508
509
510
511
512
;; Rotate logs, logic: 
;;                 if > 500k and older than 1 week:
;;                     remove previous compressed log and compress this log
;; WARNING: This proc operates assuming that it is in the directory above the
;;          logs directory you wish to log-rotate.
;;
(define (common:rotate-logs)





  (if (not (directory-exists? "logs"))(create-directory "logs"))
  (directory-fold 
   (lambda (file rem)
     (handle-exceptions
      exn

      (debug:print-info 0 *default-log-port* "unable to rotate log " file ", probably handled by another process.")


      (let* ((fullname (conc "logs/" file))
             (file-age (- (current-seconds)(file-modification-time fullname))))


        (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))))
            (let ((gzfile (conc fullname ".gz")))
              (if (common:file-exists? gzfile)
                  (begin
                    (debug:print-info 0 *default-log-port* "removing " gzfile)
                    (delete-file gzfile)))


              (debug:print-info 0 *default-log-port* "compressing " file)
              (system (conc "gzip " fullname)))




            (if (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
                (handle-exceptions
                 exn
                 #f
                 (delete-file fullname)))))))


   '()
   "logs"))














;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;; Do NOT check if not on homehost!
;;
(define (common:exit-on-version-changed)
  (if (common:on-homehost?)
      (if (common:api-changed?)
	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))







>
>
>
>
>
|
|
|
|
|
>
|
>
>
|
|
>
>
|
|
|
|
|
|
|
|
|
|
>
>
|
|
>
>
>
>
|
|
|
|
|
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|







471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
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
;; Rotate logs, logic: 
;;                 if > 500k and older than 1 week:
;;                     remove previous compressed log and compress this log
;; WARNING: This proc operates assuming that it is in the directory above the
;;          logs directory you wish to log-rotate.
;;
(define (common:rotate-logs)
  (let* ((all-files (make-hash-table))
	 (stats     (make-hash-table))
	 (inc-stat  (lambda (key)
		      (hash-table-set! stats key (+ (hash-table-ref/default stats key 0) 1))))
	(max-allowed (string->number (or (configf:lookup *configdat* "setup" "max-logfiles") "300")))) ;; name -> age
    (if (not (directory-exists? "logs"))(create-directory "logs"))
    (directory-fold 
     (lambda (file rem)
       (handle-exceptions
	exn
	(begin
	  (debug:print-info 0 *default-log-port* "unable to rotate log " file ", probably handled by another process.")
	  (debug:print 0 *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))))
	      (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 (> file-age (* (string->number (or (configf:lookup *configdat* "setup" "log-expire-days") "30")) 24 3600))
		  (handle-exceptions
		   exn
		   #f
		   (delete-file* fullname)
		   (inc-stat "deleted")
		   (hash-table-delete! all-files file)))))))
     '()
     "logs")
    (debug:print-info 0 *default-log-port* "Deleted log files: " (hash-table-ref/default stats "deleted" 0))
    (debug:print-info 0 *default-log-port* "Gzipped log files: " (hash-table-ref/default stats "gzipped" 0))    
    (let ((num-logs (hash-table-size all-files)))
      (if (> num-logs max-allowed) ;; because NFS => don't let number of logs exceed 300
	  (let ((files (take (sort (hash-table-keys all-files)
				   (lambda (a b)
				     (< (hash-table-ref all-files a)(hash-table-ref all-files b))))
			     (- num-logs max-allowed))))
	    (for-each
	     (lambda (file)
	       (delete-file* (conc "logs/" file)))
	     files)
	    (debug:print-info 0 *default-log-port* "Deleted " (length files) " from logs, keeping " max-allowed " files."))))))
  
;; Force a megatest cleanup-db if version is changed and skip-version-check not specified
;; Do NOT check if not on homehost!
;;
(define (common:exit-on-version-changed)
  (if (common:on-homehost?)
      (if (common:api-changed?)
	  (let* ((mtconf (conc (get-environment-variable "MT_RUN_AREA_HOME") "/megatest.config"))