Overview
Comment: | Do not delete server logfiles if server is still running |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.71 |
Files: | files | file ages | folders |
SHA1: |
42664e899da43e606ffce1736391dd71 |
User & Date: | mmgraham on 2024-05-30 14:28:09 |
Other Links: | branch diff | manifest | tags |
Context
2024-05-30
| ||
14:29 | Changed version to 1.7105 check-in: 88e277ab72 user: mmgraham tags: v1.71, v1.7105 | |
14:28 | Do not delete server logfiles if server is still running check-in: 42664e899d user: mmgraham tags: v1.71 | |
2024-05-14
| ||
16:41 | Changed version to v1.7104 check-in: 98b7ef274e user: mmgraham tags: v1.71, v1.7104 | |
Changes
Modified common.scm from [7944e605d1] to [b21afe069a].
︙ | ︙ | |||
523 524 525 526 527 528 529 | (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore. exn=" exn) (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)) | | > > > | > > | 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 550 551 552 553 554 555 556 557 558 559 560 561 562 | (debug:print-info 2 *default-log-port* "unable to rotate log " file ", probably handled by another process, this is safe to ignore. exn=" exn) (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))) ;; over 48 hours (file-big (> (file-size fullname) 200000))) (hash-table-set! all-files file mod-time) (if (or ;; gzip: ;; any old and big log files: (server logs, runlogs, update_ext_specs, etc. (and (string-match "^.*.log" file) file-old file-big) ;; old server log files: (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) ) ;; delete other files over expiration date: (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 |
︙ | ︙ | |||
573 574 575 576 577 578 579 | (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) | | > > > > > > > > > > > > > > > | > > > | 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 | (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) (let* ((fullname (conc "logs/" file)) (is-alive 0)) ;; Don't delete it if it's the log file of a running server. (if (string-match "server-\\d+-[a-zA-Z0-9]+\\.log" file) (let* ((parts (string-split file "-.")) (pid (cadr parts)) ; Second part is the PID (server-machine (caddr parts)) ; Third part is the server machine (local (string=? (get-host-name) server-machine)) (test-cmd (conc "test -d /proc/" pid))) (if local (set! is-alive (not (system test-cmd))) (set! is-alive (not (system (conc "ssh " server-machine " test -d /proc/" pid)))) ) ) ) (if (directory? fullname) (debug:print-info 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.") (handle-exceptions exn (debug:print-error 0 *default-log-port* "failed to remove " fullname ", exn=" exn) (if (not is-alive) (delete-file* fullname) (debug:print-info 0 *default-log-port* "Not deleting log file " file " since its server is still alive") ) )))) files) (debug:print-info 0 *default-log-port* "Deleted " (length files) " files from logs, keeping " max-allowed " files.")))))) ;;====================================================================== ;; (begin ;; (debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.") ;; (exit 1)))) |
︙ | ︙ |