ADDED   utils/softlock.scm
Index: utils/softlock.scm
==================================================================
--- /dev/null
+++ utils/softlock.scm
@@ -0,0 +1,123 @@
+;;======================================================================
+;; Copyright 2019, Matthew Welland.
+;; 
+;; This file is part of Megatest.
+;; 
+;;     Megatest is free software: you can redistribute it and/or modify
+;;     it under the terms of the GNU General Public License as published by
+;;     the Free Software Foundation, either version 3 of the License, or
+;;     (at your option) any later version.
+;; 
+;;     Megatest is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;     GNU General Public License for more details.
+;; 
+;;     You should have received a copy of the GNU General Public License
+;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;======================================================================
+
+(use posix srfi-18)
+
+
+(if (< (length (command-line-arguments)) 2) ;; require at least lockfile command
+    (begin
+      (print "Usage: 
+softlock lockfile command args ...
+
+Softlock does weak, transient locking. This is useful to slow down a
+deluge of events that can overwhelm hardware or software systems.
+
+Locks are only good for two seconds, just enough time to spread things
+out.
+
+On NFS file locking works well but the lock handling on the filers can
+be overwhelmed by too many locks occuring too quickly. Jobs that must
+use NFS file locks can use softlock to minimize the rate that the file
+locks are created, preventing the NFS filer from being swamped.
+
+Environment variables:
+
+  SOFTLOCK_DEBUG_MODE - if defined enable some messages
+
+WARNING: the file <lockfile>.softlock will be overwritten and removed by softlock!
+
+Part of the Megatest project http://www.kiatoa.com/fossils/megatest")
+      (exit 1)))
+
+(define (read-lock-file fname)
+  (handle-exceptions
+   exn
+   (begin
+     (if (get-environment-variable "SOFTLOCK_DEBUG_MODE")
+	 (print "Exception on reading lock file. exn=" exn))
+     #f)
+   (with-input-from-file fname
+     read-line)))
+
+(define (lock-file-old fname)
+  (and (file-exists? fname)
+       (> (- (current-seconds)(file-modification-time fname)) 1))) ;; hard coded to one second
+
+(define (check-locked-by-me fname mykey)
+  (if (file-exists? fname)
+      (let ((lock-data (read-lock-file fname)))
+	(if (and lock-data
+		 (equal? mykey lock-data))
+	    #t
+	    (not (lock-file-old fname)))) ;; if the lockfile is old we are NOT locked.
+      #f))
+		
+(define (check-locked-by-someone-else fname mykey)
+  (if (file-exists? fname)
+      (let ((lock-data (read-lock-file fname)))
+	(and lock-data
+	     (not (equal? mykey lock-data))
+	     (not (lock-file-old fname)))) ;; if the lockfile is old we are NOT locked.
+      #f))
+
+(define (take-lock fname mykey)
+  (with-output-to-file fname
+    (lambda ()
+      (print mykey))))
+
+(define (run-the-command command params)
+  (process-wait (process-run command params)))
+
+(let* ((lockfile (car (command-line-arguments)))
+       (fulllock (conc lockfile ".softlock")) ;; prevent accidentally removing important files
+       (lockfdir (pathname-directory lockfile))
+       (command  (cadr (command-line-arguments)))
+       (params   (cddr (command-line-arguments)))
+       (mykey    (conc (get-host-name) "-" (current-process-id))))
+  
+  ;; sanity checks
+  (cond
+   ((not lockfdir)
+    (print "ERROR: lock file parameter must include path component, e.g. ./mylock")
+    (exit 1))
+   ((not (file-write-access? lockfdir))
+    (print "ERROR: Can not access directory for lock " lockfdir)
+    (exit 1))
+   ;; add more sanity checks here
+   )
+
+  (let loop ((remtries 10))
+    (if (> remtries 0)
+	(if (check-locked-by-someone-else fulllock mykey)
+	    (begin
+	      (print "... lock " fulllock " exists, waiting...")
+	      (thread-sleep! 1.9)
+	      (loop (- remtries 1)))
+	    (begin
+	      (take-lock fulllock mykey)
+	      (if (check-locked-by-me fulllock mykey)
+		  (run-the-command command params)
+		  (begin ;; didn't get the lock
+		    (thread-sleep! (+ 1.9 (/ 1 (+ 1 (random 20))))) ;; add some noise to prevent nyquist problems
+		    (loop (- remtries 1))))))
+	(begin
+	  (print "ERROR: not able to get the lock. Gonna take it and proceed...")
+	  (take-lock fulllock mykey)
+	  (run-the-command command params)))))