/[meta-cvs]/meta-cvs/F-258A1D35AE34AADD34D34F5A328405CC.lisp
ViewVC logotype

Contents of /meta-cvs/F-258A1D35AE34AADD34D34F5A328405CC.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Fri Sep 6 02:17:27 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-24, mcvs-0-95, mcvs-0-98, mcvs-1-0-branch~branch-point, mcvs-0-97, mcvs-0-96
Branch point for: mcvs-1-0-branch
Changes since 1.4: +8 -2 lines
Low level support for versioning executable bit.

* code/unix-bindings/unix.lisp (unix-funcs:chmod): New callout
function.

* code/clisp-unix.lisp (executable-p, make-executable,
make-non-executable): New generic functions.
(executable-p (file-info), make-executable (file-info),
make-executable (string), make-non-executable (file-info),
make-non-executable (string)): New methods.

* code/add.lisp (mcvs-add): Record whether new file is
executable or not, by setting executable slot in mapping-entry.

* code/create.lisp (mcvs-create): Likewise.

* code/sync.lisp (synchronize-files): New parameter,
should-be-executable, tells function which way to set
permissions after synchronizing files.

* code/mapping.lisp (mapping-entry): New slot, executable.
(mapping-entry-parse-attributes): New function, parses
new optional property list from :FILE entries in a mapping.
(mapping-convert-in): Parse property list that may be present in fourth
list element of a :FILE entry.
(mapping-convert-out): Write out executable flag as
:EXEC property, if true.
(mapping-synchronize): Pass executable flag down to synchronize-files.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (defpackage :unix-funcs
6 (:use :ffi :lisp)
7 (:shadow :open :close)
8 (:export :null-pointer-p :errno :strerror :eperm :enoent :esrch :eintr :eio
9 :enxio :e2big :enoexec :ebadf :echild :eagain :enomem :eacces
10 :efault :enotblk :ebusy :eexist :exdev :enodev :enotdir :eisdir
11 :einval :enfile :emfile :enotty :etxtbsy :efbig :enospc :espipe
12 :erofs :emlink :epipe :edom :erange :edeadlk :enametoolong :enolck
13 :enosys :enotempty :eloop :ewouldblock :dirent :opendir :closedir
14 :readdir :ino :name :open :close :chdir :fchdir :link :symlink
15 :readlink :unlink :rmdir :stat :stat :lstat :fstat :chmod
16 :mode :nlink :uid
17 :gid :rdev :blksize :blocks :atime :mtime :ctime :s-ifmt :s-ifdir
18 :s-ifchr :s-ifblk :s-ifreg :s-ififo :s-iflnk :s-ifsock :s-isdir
19 :s-ischr :s-isblk :s-isreg :s-isfifo :s-islnk :s-issock :s-isuid
20 :s-isgid :s-isvtx :s-iread :s-iwrite :s-iexec :s-irusr :s-iwusr
21 :s-ixusr :s-irwxu :s-irgrp :s-iwgrp :s-ixgrp :s-irwxg :s-iroth
22 :s-iwoth :s-ixoth :s-irwxo :accessperms :deffilemode :o-accmode
23 :o-rdonly :o-wronly :o-rdwr :o-creat :o-excl :o-noctty :o-trunc
24 :o-append :o-nonblock :o-sync :o-async :o-ndelay :o-fsync :getcwd))
25
26 (in-package :unix-funcs)
27
28 (push :clisp-unix-funcs *features*)
29
30 ;;;
31 ;;; Null pointer test, needed in CLISP 2.27 and older.
32 ;;;
33
34 (def-c-call-out null-pointer-p
35 (:name "impl_null_pointer_p")
36 (:arguments (pointer c-pointer))
37 (:return-type boolean))
38
39 ;;;
40 ;;; <errno.h>
41 ;;;
42
43 (def-c-call-out get-errno
44 (:name "impl_get_errno")
45 (:arguments)
46 (:return-type int))
47
48 (def-c-call-out set-errno
49 (:name "impl_set_errno")
50 (:arguments (value int))
51 (:return-type int))
52
53 (defsetf get-errno set-errno)
54 (define-symbol-macro errno (get-errno))
55
56 (def-c-call-out strerror
57 (:arguments (errnum int))
58 (:return-type c-string :none))
59
60 (defconstant eperm 1)
61 (defconstant enoent 2)
62 (defconstant esrch 3)
63 (defconstant eintr 4)
64 (defconstant eio 5)
65 (defconstant enxio 6)
66 (defconstant e2big 7)
67 (defconstant enoexec 8)
68 (defconstant ebadf 9)
69 (defconstant echild 10)
70 (defconstant eagain 11)
71 (defconstant enomem 12)
72 (defconstant eacces 13)
73 (defconstant efault 14)
74 (defconstant enotblk 15)
75 (defconstant ebusy 16)
76 (defconstant eexist 17)
77 (defconstant exdev 18)
78 (defconstant enodev 19)
79 (defconstant enotdir 20)
80 (defconstant eisdir 21)
81 (defconstant einval 22)
82 (defconstant enfile 23)
83 (defconstant emfile 24)
84 (defconstant enotty 25)
85 (defconstant etxtbsy 26)
86 (defconstant efbig 27)
87 (defconstant enospc 28)
88 (defconstant espipe 29)
89 (defconstant erofs 30)
90 (defconstant emlink 31)
91 (defconstant epipe 32)
92 (defconstant edom 33)
93 (defconstant erange 34)
94 (defconstant edeadlk 35)
95 (defconstant enametoolong 36)
96 (defconstant enolck 37)
97 (defconstant enosys 38)
98 (defconstant enotempty 39)
99 (defconstant eloop 40)
100 (defconstant ewouldblock eagain)
101
102 ;;;
103 ;;; <dirent.h>
104 ;;;
105
106 (def-c-struct dirent
107 (ino ulong)
108 (name (c-array-max character 1024)))
109
110 (def-c-call-out opendir
111 (:arguments (name c-string))
112 (:return-type c-pointer))
113
114 (def-c-call-out closedir
115 (:arguments (dirp c-pointer))
116 (:return-type int))
117
118 (def-c-call-out readdir
119 (:name "impl_readdir")
120 (:arguments (dirp c-pointer))
121 (:return-type (c-ptr dirent)))
122
123 ;;;
124 ;;; <unistd.h> -- open, close
125 ;;;
126
127 (def-c-call-out open
128 (:arguments (name c-string)
129 (flags int)
130 (mode uint))
131 (:return-type int))
132
133 (def-c-call-out close
134 (:arguments (fd int))
135 (:return-type int))
136
137 ;;;
138 ;;; <unistd.h> -- chdir, fchdir
139 ;;;
140
141 (def-c-call-out chdir
142 (:arguments (path c-string))
143 (:return-type int))
144
145 (def-c-call-out fchdir
146 (:arguments (fd int))
147 (:return-type int))
148
149 ;;;
150 ;;; <unistd.h> -- link, symlink, readlink, unlink, rmdir
151
152
153 (def-c-call-out link
154 (:arguments (from c-string)
155 (to c-string))
156 (:return-type int))
157
158 (def-c-call-out symlink
159 (:arguments (from c-string)
160 (to c-string))
161 (:return-type int))
162
163 (def-c-call-out readlink
164 (:name "impl_readlink")
165 (:arguments (path c-string))
166 (:return-type c-string :malloc-free))
167
168 (def-c-call-out unlink
169 (:arguments (path c-string))
170 (:return-type int))
171
172 (def-c-call-out rmdir
173 (:arguments (path c-string))
174 (:return-type int))
175
176 ;;;
177 ;;; <unistd.h> -- stat, lstat, chmod
178 ;;;
179
180 (def-c-struct stat
181 (dev ulong)
182 (ino ulong)
183 (mode ulong)
184 (nlink uint)
185 (uid uint)
186 (gid uint)
187 (rdev ulong)
188 (blksize ulong)
189 (blocks ulong)
190 (atime ulong)
191 (mtime ulong)
192 (ctime ulong))
193
194 (def-c-call-out stat
195 (:name "impl_stat")
196 (:arguments (name c-string)
197 (buf (c-ptr stat) :out))
198 (:return-type int))
199
200 (def-c-call-out lstat
201 (:name "impl_lstat")
202 (:arguments (name c-string)
203 (buf (c-ptr stat) :out))
204 (:return-type int))
205
206 (def-c-call-out fstat
207 (:name "impl_fstat")
208 (:arguments (fd int)
209 (buf (c-ptr stat) :out))
210 (:return-type int))
211
212 (def-c-call-out chmod
213 (:arguments (name c-string)
214 (mode uint))
215 (:return-type int))
216
217 (defconstant s-ifmt #o170000)
218 (defconstant s-ifdir #o040000)
219 (defconstant s-ifchr #o020000)
220 (defconstant s-ifblk #o060000)
221 (defconstant s-ifreg #o100000)
222 (defconstant s-ififo #o010000)
223 (defconstant s-iflnk #o120000)
224 (defconstant s-ifsock #o140000)
225
226 (defmacro s-isdir (m) `(= (logand ,m s-ifmt) s-ifdir))
227 (defmacro s-ischr (m) `(= (logand ,m s-ifmt) s-ifchr))
228 (defmacro s-isblk (m) `(= (logand ,m s-ifmt) s-ifblk))
229 (defmacro s-isreg (m) `(= (logand ,m s-ifmt) s-ifreg))
230 (defmacro s-isfifo (m) `(= (logand ,m s-ifmt) s-iffifo))
231 (defmacro s-islnk (m) `(= (logand ,m s-ifmt) s-iflnk))
232 (defmacro s-issock (m) `(= (logand ,m s-ifmt) s-ifsock))
233
234 (defconstant s-isuid #o004000)
235 (defconstant s-isgid #o002000)
236 (defconstant s-isvtx #o001000)
237
238 (define-symbol-macro s-iread s-irusr)
239 (define-symbol-macro s-iwrite s-iwusr)
240 (define-symbol-macro s-iexec s-ixusr)
241
242 (defconstant s-irusr #o000400)
243 (defconstant s-iwusr #o000200)
244 (defconstant s-ixusr #o000100)
245 (defconstant s-irwxu (logior s-irusr s-iwusr s-ixusr))
246 (defconstant s-irgrp #o000040)
247 (defconstant s-iwgrp #o000020)
248 (defconstant s-ixgrp #o000010)
249 (defconstant s-irwxg (logior s-irgrp s-iwgrp s-ixgrp))
250 (defconstant s-iroth #o000004)
251 (defconstant s-iwoth #o000002)
252 (defconstant s-ixoth #o000001)
253 (defconstant s-irwxo (logior s-iroth s-iwoth s-ixoth))
254
255 (defconstant accessperms (logior s-irwxu s-irwxg s-irwxo))
256 (defconstant deffilemode (logior s-irusr s-iwusr s-irgrp s-iwgrp s-iroth s-iwoth))
257
258 ;;;
259 ;;; <unistd.h> -- getcwd
260
261 (def-c-call-out getcwd
262 (:name "impl_getcwd")
263 (:arguments)
264 (:return-type c-string :malloc-free))
265
266 ;;;
267 ;;; <fcntl.h>
268 ;;;
269
270 (defconstant o-accmode #o00003)
271 (defconstant o-rdonly #o00000)
272 (defconstant o-wronly #o00001)
273 (defconstant o-rdwr #o00002)
274 (defconstant o-creat #o00100)
275 (defconstant o-excl #o00200)
276 (defconstant o-noctty #o00400)
277 (defconstant o-trunc #o01000)
278 (defconstant o-append #o02000)
279 (defconstant o-nonblock #o04000)
280 (defconstant o-sync #o10000)
281 (defconstant o-async #o20000)
282 (defconstant o-ndelay o-nonblock)
283 (defconstant o-fsync o-sync)

  ViewVC Help
Powered by ViewVC 1.1.5