commit d1e151d8bb404261061312f50ee991c827902a83
parent ea715b3e43d05a0ad82f0c9c5dfd99de86a72eb4
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 6 Dec 2015 09:19:13 +0100
add with-flock
Diffstat:
| M | os.lisp | | | 36 | ++++++++++++++++++++++++++++++++++++ |
1 file changed, 36 insertions(+), 0 deletions(-)
diff --git a/os.lisp b/os.lisp
@@ -29,6 +29,7 @@
:md5sum
:run-command
:sha1sum
+ :with-flock
:with-program-io
:with-program-output
:with-temporary-file))
@@ -309,3 +310,38 @@
;;(cp "/etc/passwd" "/tmp/a")
;;(cp "/asdf" "/tmp/a")
+
+(defun %flock (stream op)
+ #-sbcl
+ (error "TODO %flock not ported")
+ #+sbcl
+ (let ((fd (sb-c::fd-stream-fd stream)))
+ (sb-alien:with-alien ((flock (function sb-alien:int
+ sb-alien:int
+ sb-alien:int)
+ :extern "flock"))
+ (values (sb-alien:alien-funcall flock fd op)))))
+
+(defun flock (stream operation blockp)
+ #-(and linux sbcl)
+ (error "TODO flock not ported")
+ #+(and linux sbcl)
+ (ecase (%flock stream
+ (logior (if blockp 0 4)
+ (ecase operation
+ (:shared 1)
+ (:exclusive 2)
+ (:unlock 8))))
+ (0 (values))
+ (-1 (error "flock ~s ~s ~s failed with code ~s"
+ stream operation blockp (sb-alien:get-errno)))))
+
+(defun call-with-flock (pathname shared fn)
+ (with-open-file (s pathname
+ :direction :output
+ :if-exists :overwrite)
+ (flock s (if shared :shared :exclusive) t)
+ (funcall fn)))
+
+(defmacro with-flock ((pathname &key shared) &body body)
+ `(call-with-flock ,pathname ,shared (lambda () ,@body)))
