Overview
| Comment: | Cleaned up removal messages. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
b4cfcf101b0929661678ac3aa89223d7 |
| User & Date: | matt on 2012-10-24 17:25:55 |
| Other Links: | manifest | tags |
Context
|
2012-10-29
| ||
| 09:40 | Added json to list of eggs to install in installall.sh check-in: a8d9c84248 user: mrwellan tags: trunk | |
|
2012-10-26
| ||
| 08:06 | starting to fix/improve the monitor check-in: 92290be7f6 user: matt tags: monitor-cleanup | |
|
2012-10-24
| ||
| 17:25 | Cleaned up removal messages. check-in: b4cfcf101b user: matt tags: trunk | |
| 12:56 | bumped-version-to-v1.51 check-in: 244782c0ff user: matt tags: trunk, v1.51 | |
Changes
Modified runs.scm from [310fe61f1f] to [b87bc4f5c0].
| ︙ | ︙ | |||
769 770 771 772 773 774 775 | #f)) (test-id (db:test-get-id test))) ;; (tdb (db:open-test-db run-dir))) (debug:print-info 4 "test=" test) ;; " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path " action: " action) (case action ((remove-runs) ;; the tdb is for future possible. (open-run-close db:delete-test-records db #f (db:test-get-id test)) | | | > | > > | > | 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | #f)) (test-id (db:test-get-id test))) ;; (tdb (db:open-test-db run-dir))) (debug:print-info 4 "test=" test) ;; " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path " action: " action) (case action ((remove-runs) ;; the tdb is for future possible. (open-run-close db:delete-test-records db #f (db:test-get-id test)) (debug:print-info 1 "Attempting to remove " (if real-dir (conc " dir " real-dir " and ") "") " link " run-dir) (if (and real-dir (> (string-length real-dir) 5) (file-exists? real-dir)) ;; bad heuristic but should prevent /tmp /home etc. (begin ;; let* ((realpath (resolve-pathname run-dir))) (debug:print-info 1 "Recursively removing " real-dir) (if (file-exists? real-dir) (if (> (system (conc "rm -rf " real-dir)) 0) (debug:print 0 "ERROR: There was a problem removing " real-dir " with rm -f")) (debug:print 0 "WARNING: test dir " real-dir " appears to not exist or is not readable"))) (if real-dir (debug:print 0 "WARNING: directory " real-dir " does not exist") (debug:print 0 "WARNING: no real directory corrosponding to link " run-dir ", nothing done"))) (if (symbolic-link? run-dir) (begin (debug:print-info 1 "Removing symlink " run-dir) (delete-file run-dir)) (if (directory? run-dir) (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0) (debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty") (delete-directory run-dir)) ;; it should be empty by here BUG BUG, add error catch (if run-dir (debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink") (debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted.")) ))) ((set-state-status) (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status)) (open-run-close db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f))))) (sort tests (lambda (a b)(let ((dira (db:test-get-rundir a)) (dirb (db:test-get-rundir b))) (if (and (string? dira)(string? dirb)) |
| ︙ | ︙ |