Changed the license to the AGPL3. Downcased all the lisp sources. Completed the READM...
[com-informatimago:com-informatimago.git] / cl-posix / susv3.lisp
1 ;;;; -*- coding:utf-8 -*-
2 ;;;;****************************************************************************
3 ;;;;FILE:               susv3.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             CLISP
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    This packages exports SUSV3 functions.
10 ;;;;    This is the CLISP specific implementation of the SUSV3 API.
11 ;;;;
12 ;;;;
13 ;;;;    The Open Group Base Specifications Issue 6
14 ;;;;    IEEE Std 1003.1, 2003 Edition
15 ;;;;
16 ;;;;    http://www.opengroup.org/onlinepubs/007904975/index.html
17 ;;;;
18 ;;;;AUTHORS
19 ;;;;    <PJB> Pascal Bourguignon
20 ;;;;MODIFICATIONS
21 ;;;;    2003-06-13 <PJB> Added dirent stuff.
22 ;;;;    2003-05-13 <PJB> Created
23 ;;;;BUGS
24 ;;;;
25 ;;;;    Check if the name is correct: there is a hierarchy of specifications
26 ;;;;    in sus3. I want to avoid using #+XSI, but rather have different
27 ;;;;    interfaces: (:USE SUSV3) (:USE SUSV3-XSI).
28 ;;;;
29 ;;;;
30 ;;;;LEGAL
31 ;;;;    AGPL3
32 ;;;;    
33 ;;;;    Copyright Pascal Bourguignon 2003 - 2003
34 ;;;;    
35 ;;;;    This program is free software: you can redistribute it and/or modify
36 ;;;;    it under the terms of the GNU Affero General Public License as published by
37 ;;;;    the Free Software Foundation, either version 3 of the License, or
38 ;;;;    (at your option) any later version.
39 ;;;;    
40 ;;;;    This program is distributed in the hope that it will be useful,
41 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
42 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
43 ;;;;    GNU Affero General Public License for more details.
44 ;;;;    
45 ;;;;    You should have received a copy of the GNU Affero General Public License
46 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
47 ;;;;****************************************************************************
48
49
50 (defpackage "COM.INFORMATIMAGO.CLISP.SUSV3"
51   (:documentation "This packages exports SUSV3 functions.
52     This is the CLISP specific implementation of the SUSV3 API.")
53   (:use "COMMON-LISP"
54         "EXT" "LINUX")
55   (:export
56    
57    ;; NOT IN SUSV3 API (Lisp/C support stuff):
58    "BOUND-STRING" ;; type (BOUND-STRING min max)
59    "SUSV3-ERROR" ;; (SIGNAL 'SUSV3-ERROR errno)
60
61    ;; 
62    "GETENV"
63
64    ;; sys/types.h
65    "INO-T"
66    
67
68    ;; sys/stat.h
69
70    
71    ;; limits.h
72    "+NAME-MAX+"
73
74    ;; dirent.h
75    "DIR" "DIRENT"
76    "OPENDIR" "READDIR" "REWINDDIR" "CLOSEDIR"
77    ;; readdir_r ;; TSF ;; not implemented, do we need it? 
78    "SEEKDIR" "TELLDIR" ;; XSI
79
80
81
82    
83    ;; NOT IN SUSV3 API (TEST FUNCTIONS):
84    "DIRENT-TEST"))
85 (in-package  "COM.INFORMATIMAGO.CLISP.SUSV3")
86
87
88
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 ;; Lisp/C support stuff
91
92
93 (deftype bound-string (min max)
94   "A TYPE REPRESENTING STRINGS OF MINIMUM SIZE MIN AND MAXIMUM SIZE MAX."
95   (if (= (eval min) (eval max))
96     `(string ,(eval min))
97     `string) ;; TODO: (OR (STRING MIN) (STRING (1+ MIN)) ... (STRING MAX))
98   );;BOUND-STRING
99
100
101 (define-condition susv3-error ()
102   (
103    (errno :initarg :errno
104           :accessor errno
105           :type (signed-byte 32))
106    ));;SUSV3-ERROR
107
108   
109 (defmacro check-errno (&body body)
110   `(progn
111      (setq linux:|errno| 0)
112      (let ((result (progn ,@body)))
113        (if (/= 0 linux:|errno|)
114          (signal (make-condition 'susv3-error  :errno linux:|errno|))
115          result)))
116   );;CHECK-ERRNO
117
118      
119
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;; ???
122
123
124 (declare (ftype (function (string) (or null string)) getenv))
125
126
127 (defun getenv (name)
128   "
129 URL:        http://www.opengroup.org/onlinepubs/007904975/functions/getenv.html
130 RETURN:     NIL or the value of the environment variable named NAME.
131 "
132   (ext:getenv name)
133   );;GETENV
134
135
136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137 ;; sys/types.h
138
139
140 (deftype ino-t ()
141   "The type of file serial numbers."
142   `(unsigned-byte 32)
143   );;INO-T
144
145
146 (deftype dev-t ()
147   "Device ID."
148   `(unsigned-byte 32)
149   );;DEV-T
150
151
152 (deftype mode-t ()
153   "Mode of file."
154   `(unsigned-byte 32)
155   );;MODE-T
156
157
158 (deftype nlink-t ()
159   "Number of hard links to the file."
160   `(unsigned-byte 32)
161   );;NLINK-T
162
163
164 (deftype uid-t ()
165   "User ID."
166   `(unsigned-byte 32)
167   );;UID-T
168
169
170 (deftype gid-t ()
171   "Group ID."
172   `(unsigned-byte 32)
173   );;GID-T
174
175
176 (deftype time-t ()
177   "Time in seconds since epoch."
178   `(unsigned-byte 32)
179   );;TIME-T
180
181
182
183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
184 ;; sys/stat.h
185
186
187 (deftype blksize-t
188   ""
189   `(unsigned-byte 32)
190   );;BLKSIZE-T
191
192
193 (deftype blkcnt-t
194   ""
195   `(unsigned-byte 32)
196   );;BLKCNT-T
197
198
199   
200 (defstruct stat
201   (dev     0 :type dev-t) ;; Device ID of device containing file. 
202   (ino     0 :type ino-t) ;; File serial number. 
203   (mode    0 :type mode-t) ;; Mode of file (see below).
204   (nlink   0 :type nlink-t) ;; Number of hard links to the file.
205   (uid     0 :type uid-t) ;; User ID of file.
206   (gid     0 :type gid-t) ;; Group ID of file.
207   (rdev    0 :type dev-t) ;; XSI: Device ID (if file is char or block special).
208   (size    0 :type off-t) ;; For regular files, the file size in bytes. 
209   ;;                      For symbolic links, the length in bytes of the 
210   ;;                      pathname contained in the symbolic link. 
211   ;;                      SHM: For a shared memory object, the length in bytes.
212   ;;                      TYM: For a typed memory object, the length in bytes. 
213   ;;                      For other file types, the use of this field is 
214   ;;                      unspecified.
215   (atime   0 :type time-t) ;; Time of last access.
216   (mtime   0 :type time-t) ;; Time of last data modification.
217   (ctime   0 :type time-t) ;; Time of last status change.
218   (blksize 0 :type blksize-t) ;; XSI: A file system-specific preferred I/O 
219   ;;                      block size for this object. In some file system 
220   ;;                      types, this may vary from file to file.
221   (blocks  0 :type blkcnt-t) ;; XSI: Num. of blocks allocated for this object.
222   );;STAT
223
224
225 ;; The st_ino and st_dev fields taken together uniquely identify the
226 ;; file within the system. The blkcnt_t, blksize_t, dev_t, ino_t,
227 ;; mode_t, nlink_t, uid_t, gid_t, off_t, and time_t types shall be
228 ;; defined as described in <sys/types.h> . Times shall be given in
229 ;; seconds since the Epoch.
230
231 ;; Unless otherwise specified, the structure members st_mode, st_ino,
232 ;; st_dev, st_uid, st_gid, st_atime, st_ctime, and st_mtime shall have
233 ;; meaningful values for all file types defined in IEEE Std
234 ;; 1003.1-2001.
235  
236 ;; For symbolic links, the st_mode member shall contain meaningful
237 ;; information, which can be used with the file type macros described
238 ;; below, that take a mode argument. The st_size member shall contain
239 ;; the length, in bytes, of the pathname contained in the symbolic
240 ;; link. File mode bits and the contents of the remaining members of
241 ;; the stat structure are unspecified. The value returned in the
242 ;; st_size field shall be the length of the contents of the symbolic
243 ;; link, and shall not count a trailing null if one is present.
244  
245
246 ;; The following symbolic names for the values of type mode_t shall
247 ;; also be defined.
248  
249 ;; File type:
250 ;; 
251 ;; S_IFMT
252 ;;     [XSI] [Option Start] Type of file.
253 ;; 
254 ;;     S_IFBLK
255 ;;     Block special.S_IFCHR
256 ;;     Character special.S_IFIFO
257 ;;     FIFO special.S_IFREG
258 ;;     Regular.S_IFDIR
259 ;;     Directory.S_IFLNK
260 ;;     Symbolic link.S_IFSOCK
261 ;;     Socket. [Option End]
262
263 (defconstant s-ifmt  #o0170000)
264 (defconstant s-ifdir  #o040000)
265 (defconstant s-ifchr  #o020000)
266 (defconstant s-ifblk  #o060000)
267 (defconstant s-ifreg  #o100000)
268 (defconstant s-ififo  #o010000)
269 (defconstant s-iflnk  #o120000)
270 (defconstant s-ifsock #o140000)
271
272
273 ;; File mode bits:
274 ;; 
275 ;; S_IRWXU
276 ;;     Read, write, execute/search by owner.
277 ;; 
278 ;;     S_IRUSR
279 ;;     Read permission, owner.S_IWUSR
280 ;;     Write permission, owner.S_IXUSR
281 ;;     Execute/search permission, owner.
282 ;; S_IRWXG
283 ;;     Read, write, execute/search by group.
284 ;; 
285 ;;     S_IRGRP
286 ;;     Read permission, group.S_IWGRP
287 ;;     Write permission, group.S_IXGRP
288 ;;     Execute/search permission, group.
289 ;; S_IRWXO
290 ;;     Read, write, execute/search by others.
291 ;; 
292 ;;     S_IROTH
293 ;;     Read permission, others.S_IWOTH
294 ;;     Write permission, others.S_IXOTH
295 ;;     Execute/search permission, others.
296 ;; S_ISUID
297 ;; Set-user-ID on execution.S_ISGID
298 ;; Set-group-ID on execution.S_ISVTX
299 ;; [XSI] [Option Start] On directories, restricted deletion flag. [Option End]
300  
301 ;; The bits defined by S_IRUSR, S_IWUSR, S_IXUSR, S_IRGRP, S_IWGRP,
302 ;; S_IXGRP, S_IROTH, S_IWOTH, S_IXOTH, S_ISUID, S_ISGID, [XSI] [Option
303 ;; Start]  and S_ISVTX [Option End]  shall be unique.
304  
305 ;; S_IRWXU is the bitwise-inclusive OR of S_IRUSR, S_IWUSR, and S_IXUSR.
306 ;; 
307 ;; S_IRWXG is the bitwise-inclusive OR of S_IRGRP, S_IWGRP, and S_IXGRP.
308 ;; 
309 ;; S_IRWXO is the bitwise-inclusive OR of S_IROTH, S_IWOTH, and S_IXOTH.
310  
311 ;; Implementations may OR other implementation-defined bits into
312 ;; S_IRWXU, S_IRWXG, and S_IRWXO, but they shall not overlap any of
313 ;; the other bits defined in this volume of IEEE Std 1003.1-2001. The
314 ;; file permission bits are defined to be those corresponding to the
315 ;; bitwise-inclusive OR of S_IRWXU, S_IRWXG, and S_IRWXO.
316
317
318 (defconstant s-isuid  #o004000)
319 (defconstant s-isgid  #o002000)
320 (defconstant s-isvtx  #o001000)
321
322 (define-symbol-macro s-iread s-irusr)
323 (define-symbol-macro s-iwrite s-iwusr)
324 (define-symbol-macro s-iexec s-ixusr)
325
326 (defconstant s-irusr  #o000400)
327 (defconstant s-iwusr  #o000200)
328 (defconstant s-ixusr  #o000100)
329 (defconstant s-irwxu  (logior s-irusr s-iwusr s-ixusr))
330 (defconstant s-irgrp  #o000040)
331 (defconstant s-iwgrp  #o000020)
332 (defconstant s-ixgrp  #o000010)
333 (defconstant s-irwxg  (logior s-irgrp s-iwgrp s-ixgrp))
334 (defconstant s-iroth  #o000004)
335 (defconstant s-iwoth  #o000002)
336 (defconstant s-ixoth  #o000001)
337 (defconstant s-irwxo  (logior s-iroth s-iwoth s-ixoth))
338
339
340 ;; The following macros shall be provided to test whether a file is of
341 ;; the specified type. The value m supplied to the macros is the value
342 ;; of st_mode from a stat structure. The macro shall evaluate to a
343 ;; non-zero value if the test is true; 0 if the test is false.
344  
345 ;; S_ISBLK(m)
346 ;; 
347 ;; Test for a block special file.S_ISCHR(m)
348 ;; Test for a character special file.S_ISDIR(m)
349 ;; Test for a directory.S_ISFIFO(m)
350 ;; Test for a pipe or FIFO special file.S_ISREG(m)
351 ;; Test for a regular file.S_ISLNK(m)
352 ;; Test for a symbolic link.S_ISSOCK(m)
353 ;; Test for a socket.
354
355 (defmacro s-isdir  (m) `(= (logand ,m s-ifmt) s-ifdir))
356 (defmacro s-ischr  (m) `(= (logand ,m s-ifmt) s-ifchr))
357 (defmacro s-isblk  (m) `(= (logand ,m s-ifmt) s-ifblk))
358 (defmacro s-isreg  (m) `(= (logand ,m s-ifmt) s-ifreg))
359 (defmacro s-isfifo (m) `(= (logand ,m s-ifmt) s-iffifo))
360 (defmacro s-islnk  (m) `(= (logand ,m s-ifmt) s-iflnk))
361 (defmacro s-issock (m) `(= (logand ,m s-ifmt) s-ifsock))
362
363
364 ;; The implementation may implement message queues, semaphores, or
365 ;; shared memory objects as distinct file types. The following macros
366 ;; shall be provided to test whether a file is of the specified
367 ;; type. The value of the buf argument supplied to the macros is a
368 ;; pointer to a stat structure. The macro shall evaluate to a non-zero
369 ;; value if the specified object is implemented as a distinct file
370 ;; type and the specified file type is contained in the stat structure
371 ;; referenced by buf. Otherwise, the macro shall evaluate to zero.
372  
373 ;; S_TYPEISMQ(buf)
374 ;; Test for a message queue.S_TYPEISSEM(buf)
375 ;; Test for a semaphore.S_TYPEISSHM(buf)
376 ;; Test for a shared memory object.
377  
378 ;; [TYM] [Option Start] The implementation may implement typed memory
379 ;; objects as distinct file types, and the following macro shall test
380 ;; whether a file is of the specified type. The value of the buf
381 ;; argument supplied to the macros is a pointer to a stat
382 ;; structure. The macro shall evaluate to a non-zero value if the
383 ;; specified object is implemented as a distinct file type and the
384 ;; specified file type is contained in the stat structure referenced
385 ;; by buf. Otherwise, the macro shall evaluate to zero.
386  
387 ;; S_TYPEISTMO(buf)
388 ;; Test macro for a typed memory object.
389 ;; [Option End]
390  
391 ;; The following shall be declared as functions and may also be
392 ;; defined as macros. Function prototypes shall be provided.
393  
394 ;; int    chmod(const char *, mode_t);
395 ;; int    fchmod(int, mode_t);
396 ;; int    fstat(int, struct stat *);
397 ;; int    lstat(const char *restrict, struct stat *restrict);
398 ;; int    mkdir(const char *, mode_t);
399 ;; int    mkfifo(const char *, mode_t);
400 ;; [XSI][Option Start]
401 ;; int    mknod(const char *, mode_t, dev_t);
402 ;; [Option End]
403 ;; int    stat(const char *restrict, struct stat *restrict);
404 ;; mode_t umask(mode_t);
405
406 (declare
407  (ftype (function (string mode-t)  nil)    chmod)
408  (ftype (function (integer mode-t) nil)    fchmod)
409  (ftype (function (integer)        stat)   fstat)
410  (ftype (function (string)         stat)   lstat)
411  (ftype (function (string)         stat)   stat)
412  (ftype (function (string mode-t)  nil)    mkdir)
413  (ftype (function (string mode-t)  nil)    mkfifo)
414  (ftype (function (mode-t)         mode-t) umask)
415  )
416
417 (declare ;; XSI
418  (ftype (function (string mode-t dev-t) nil) mknod)
419 )
420
421
422
423 (defun chmod (path mode)
424   (check-errno (linux:|chmod| path mode))
425   (values)
426   );;CHMOD
427
428
429 (defun fchmod (fd mode)
430   (check-errno (linux:|fchmod| fd mode))
431   (values)
432   );;FCHMOD
433
434
435 (defmacro linux-stat->susv3-stat (sb)
436   "
437 PRIVATE
438 "
439   `(make-stat 
440     :dev (linux:|stat-st_dev| ,sb)
441     :ino (linux:|stat-st_ino| ,sb)
442     :mode (linux:|stat-st_mode| ,sb)
443     :nlink (linux:|stat-st_nlink| ,sb)
444     :uid (linux:|stat-st_uid| ,sb)
445     :gid (linux:|stat-st_gid| ,sb)
446     :rdev (linux:|stat-st_rdev| ,sb)
447     :size (linux:|stat-st_size| ,sb)
448     :atime (linux:|stat-st_atime| ,sb)
449     :mtime (linux:|stat-st_mtime| ,sb)
450     :ctime (linux:|stat-st_ctime| ,sb)
451     :blksize (linux:|stat-st_blksize| ,sb)
452     :blocks (linux:|stat-st_blocks| ,sb))
453   );;LINUX-STAT->SUSV3-STAT
454
455
456 (defun stat (path)
457     (linux-stat->susv3-stat (check-errno (linux:|stat| path)))
458   );;STAT
459
460
461 (defun lstat (path)
462     (linux-stat->susv3-stat (check-errno (linux:|lstat| path)))
463   );;LSTAT
464
465
466 (defun fstat (fd)
467     (linux-stat->susv3-stat (check-errno (linux:|fstat| fd)))
468   );;FSTAT
469
470
471 (defun mkdir (path mode)
472   (check-errno (linux:|mkdir| path mode))
473   (values)
474   );;MKDIR
475
476
477 (defun mkfifo (path mode)
478   (check-errno (linux:|mkfifo| path mode))
479   (values)
480   );;MKFIFO
481
482
483 (defun umask (mode)
484   (linux:|umask| mode)
485   );;UMASK
486
487
488   ;;XSI
489 (defun mknod (path mode device)
490   (check-errno (linux:|mknod| path mode device))
491   (values)
492   );;MKNOD
493
494
495
496 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
497 ;; dirent.h
498
499 (defconstant +name-max+ 255)
500
501
502 (deftype dir () 
503   "A type representing a directory stream."
504   `t
505   );;DIR
506
507
508 (defstruct dirent 
509   (ino  0  :type ino-t) ;; File serial number
510   (name "" :type (bound-string 0 +name-max+)) ;; Name of entry
511   );;DIRENT
512
513
514 (declaim
515  (ftype (function (dir)    integer)          closedir)
516  (ftype (function (string) (or null dir))    opendir)
517  (ftype (function (dir)    (or null dirent)) readdir)
518  (ftype (function (dir)    nil)              rewinddir)
519  )
520
521
522 (declaim ;; XSI
523  (ftype (function (dir integer) nil)         seekdir)
524  (ftype (function (dir)         integer)     telldir)
525  )
526
527
528 (defun opendir (path)
529   (check-errno (linux:|opendir| path))
530   );;OPENDIR
531
532
533 (defun closedir (dir-stream)
534   (check-errno (linux:|closedir| dir-stream))
535   );;CLOSEDIR
536
537
538 (defun readdir (dir-stream)
539   (let ((c-dirent (check-errno (linux:|readdir| dir-stream))))
540     (and c-dirent
541          (make-dirent :ino (linux::|dirent-d_ino| c-dirent)
542                       :name (linux::|dirent-d_name| c-dirent))))
543   );;READDIR
544
545
546 (defun rewinddir (dir-stream)
547   (check-errno (linux:|rewinddir| dir-stream))
548   (values)
549   );;REWINDDIR
550
551
552
553 (defun seekdir (dir-stream position)
554   (check-errno (linux:|seekdir| dir-stream position))
555   (values)
556   );;SEEKDIR
557
558
559 (defun telldir (dir-stream)
560   (check-errno (linux:|telldir| dir-stream))
561   );;TELLDIR
562
563
564
565
566 (defun dirent-test ()
567   (do* ((dir-stream (opendir "/tmp"))
568         (entry (readdir dir-stream) (readdir dir-stream)))
569       ((null entry))
570     (format t "entry: ~8D ~S~%" (dirent-ino entry) (dirent-name entry)))
571   );;DIRENT-TEST
572
573
574
575 ;;;; THE END ;;;;