97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
-
+
+
-
+
-
+
+
-
+
-
-
+
+
|
(if (not (file-exists? softlocks-dir))
(create-directory softlocks-dir #t))
(let* ((my-lock-file (conc softlocks-dir "/" key "-" (get-host-name) "-" (current-process-id) ".softlock"))
(lock-files (filter (lambda (x)
(not (equal? x my-lock-file)))
(glob (conc softlocks-dir "/" key "*.softlock"))))
(fresh-locks (any (lambda (x) ;; do we have any locks younger than 10 seconds
(let ((mod-time (file-modification-time x)))
(let* ((mod-time (file-modification-time x))
(age (- (current-seconds) mod-time)))
(cond
((> (- (current-seconds) mod-time) 3600) ;; too old to keep, remove it
((> age 3600) ;; too old to keep, remove it
(delete-file* x) #f)
((< mod-time 10) #t)
((< age 10) #t)
(else #f))))
lock-files)))
(if fresh-locks
(begin
(if (runs:lownoise "runners-softlock-wait" 360)
(debug:print-info 0 *default-log-port* "Other runners in flight, giving up some time..."))
(thread-sleep! 10))
(begin
(if (runs:lownoise "runners-softlock-nowait" 360)
(debug:print-info 0 *default-log-port* "No runners in flight, updating softlock"))
(let* ((ouf (open-output-file my-lock-file)))
(with-output-to-file my-lock-file
(with-output-to-port ouf
(lambda ()
(print (current-seconds))))))
|