;;; -*-lisp-*-
;;;
-;;; $Id$
-;;;
;;; Unix system call stuff
;;;
;;; (c) 2005 Straylight/Edgeware
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:mdw.unix
- (:use #:common-lisp #:mdw.base #:collect)
- (:export #:unix-error #:errno-value #:with-errno-handlers
- #:syscall #:syscall*
- #:stat #:sys-stat
- #:sys-open #:sys-close #:sys-read #:sys-write
- #:sys-chown #:sys-fchown #:sys-chmod #:sys-fchmod
- #:sys-utimes #:sys-unlink #:sys-rename
- #:sys-gettimeofday #:sys-gethostname
- #:with-unix-open #:copy-file))
+ (:use #:common-lisp #:mdw.base #:collect))
(in-package #:mdw.unix)
(defmacro with-buffer ((var len) &body body)
,@body)
(when ,var (system:deallocate-system-memory ,var ,lenvar))))))
+(export '(unix-error unix-error-func unix-error-args unix-error-errno))
(define-condition unix-error (error)
((func :initform 'unknown :initarg :func :reader unix-error-func)
(args :initform nil :initarg :args :reader unix-error-args)
(unix-error-errno c))))
(:documentation "Reports an error from a Unix system call."))
+(export 'errno-value)
(compile-time-defun errno-value (err)
- "Returns the numeric value corresponding to an errno name."
- (etypecase err
- (integer err)
- (symbol (symbol-value (intern (symbol-name err) :unix)))))
+ "Returns the numeric value corresponding to an errno name."
+ (etypecase err
+ (integer err)
+ (symbol (symbol-value (intern (symbol-name err) :unix)))))
+(export 'with-errno-handlers)
(defmacro with-errno-handlers ((&key cond
(errno (gensym))
errstring)
clauses
labels)))))))))
+(export 'syscall*)
(defun syscall* (name func &rest args)
"Call Unix system call FUNC, passing it ARGS. If it returns an error,
signal the unix-error condition, with NAME and ARGS."
:errno (car stuff)))
(apply #'values rc stuff))
(apply func args)))
+
+(export 'syscall)
(defmacro syscall (func &rest args)
"Call Unix system call FUNC, passing it ARGS. If it returns an error,
signal the unix-error condition, with FUNC and ARGS."
`(syscall* ',func
#',func ,@args))
+(export '(stat statp))
(macrolet ((doit (doc slots)
- `(defstruct (stat (:predicate statp)
- (:conc-name st-)
- (:constructor %make-stat-boa ,slots))
- ,doc
- ,@slots)))
+ `(progn
+ (export ',(mapcar (lambda (slot) (symbolicate 'st- slot))
+ slots))
+ (defstruct (stat (:predicate statp)
+ (:conc-name st-)
+ (:constructor %make-stat-boa ,slots))
+ ,doc
+ ,@slots))))
(doit
- "Structure representing all the useful information `stat' returns about a
- file."
- (dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks)))
+ "Structure representing all the useful information `stat' returns about a
+ file."
+ (dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks)))
+
+(export 'sys-stat)
(defun sys-stat (file)
"Return information about FILE in a structure rather than as inconvenient
multiple values."
(unix:unix-stat file)))
(defmacro defsyscall (name)
- (let ((sysname (intern (format nil "SYS-~:@(~A~)" name)))
- (unixname (intern (format nil "UNIX-~:@(~A~)" name) :unix)))
- `(defun ,sysname (&rest args)
- (apply #'syscall* ',sysname #',unixname args))))
+ (let ((sysname (symbolicate 'sys- name))
+ (unixname (let ((*package* (find-package :unix)))
+ (symbolicate 'unix- name))))
+ `(progn
+ (export ',sysname)
+ (defun ,sysname (&rest args)
+ (apply #'syscall* ',sysname #',unixname args)))))
(macrolet ((defsys (&rest names)
`(progn ,@(mapcar (lambda (name)
unlink rename
gethostname gettimeofday))
+(export 'with-unix-open)
(defmacro with-unix-open ((fd file how &optional (mode #o666)) &body body)
"Evaluate BODY with FD bound to a file descriptor obtained from a Unix
`open' syscall with arguments FILE, HOW and MODE. Close the file
,@body)
(when ,fd (sys-close ,fd)))))
+(export 'copy-file)
(defun copy-file (from to &optional (how 0))
"Make a copy of the file FROM called TO. The copy has the same permissions
and timestamps (except for ctime) and attempts to have the same owner and