cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit d1e151d8bb404261061312f50ee991c827902a83
parent ea715b3e43d05a0ad82f0c9c5dfd99de86a72eb4
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  6 Dec 2015 09:19:13 +0100

add with-flock

Diffstat:
Mos.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)))