~ chicken-core (master) /posix.scm

  1;;;; posix.scm - Platform-specific routines
  2;
  3; Copyright (c) 2008-2022, The CHICKEN Team
  4; Copyright (c) 2000-2007, Felix L. Winkelmann
  5; All rights reserved.
  6;
  7; Redistribution and use in source and binary forms, with or without
  8; modification, are permitted provided that the following conditions are
  9; met:
 10;
 11;   Redistributions of source code must retain the above copyright
 12;   notice, this list of conditions and the following disclaimer.
 13;
 14;   Redistributions in binary form must reproduce the above copyright
 15;   notice, this list of conditions and the following disclaimer in the
 16;   documentation and/or other materials provided with the distribution.
 17;
 18;   Neither the name of the author nor the names of its contributors may
 19;   be used to endorse or promote products derived from this software
 20;   without specific prior written permission.
 21;
 22; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 23; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 24; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 25; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 26; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
 27; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
 28; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
 29; OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 30; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
 31; TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
 32; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 33; DAMAGE.
 34
 35
 36(declare
 37  (unit posix)
 38  (uses scheduler pathname extras port lolevel)
 39  (disable-interrupts)
 40  (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
 41
 42
 43(module chicken.file.posix
 44  (create-fifo create-symbolic-link read-symbolic-link
 45   duplicate-fileno fcntl/dupfd fcntl/getfd fcntl/getfl fcntl/setfd
 46   fcntl/setfl file-access-time file-change-time file-modification-time
 47   file-close file-control file-creation-mode file-group file-link
 48   file-lock file-lock/blocking file-mkstemp file-open file-owner
 49   file-permissions file-position file-read file-select file-size
 50   file-stat file-truncate file-unlock file-write
 51   file-type block-device? character-device? directory? fifo?
 52   regular-file? socket? symbolic-link?
 53   fileno/stderr fileno/stdin fileno/stdout
 54   open-input-file* open-output-file*
 55   open/append open/binary open/creat open/excl open/fsync open/noctty
 56   open/noinherit open/nonblock open/rdonly open/rdwr open/read
 57   open/sync open/text open/trunc open/write open/wronly
 58   perm/irgrp perm/iroth perm/irusr perm/irwxg perm/irwxo perm/irwxu
 59   perm/isgid perm/isuid perm/isvtx perm/iwgrp perm/iwoth perm/iwusr
 60   perm/ixgrp perm/ixoth perm/ixusr
 61   port->fileno set-file-group! set-file-owner!
 62   set-file-permissions! set-file-position! set-file-times!
 63   seek/cur seek/set seek/end)
 64
 65(import scheme)
 66
 67;; These are all set! inside the posix module
 68(define create-fifo)
 69(define create-symbolic-link)
 70(define read-symbolic-link)
 71(define duplicate-fileno)
 72
 73(define fcntl/dupfd)
 74(define fcntl/getfd)
 75(define fcntl/getfl)
 76(define fcntl/setfd)
 77(define fcntl/setfl)
 78
 79(define file-access-time)
 80(define file-change-time)
 81(define file-modification-time)
 82(define file-close)
 83(define file-control)
 84(define file-creation-mode)
 85(define file-group)
 86(define file-link)
 87(define file-lock)
 88(define file-lock/blocking)
 89(define file-mkstemp)
 90(define file-open)
 91(define file-owner)
 92(define file-permissions)
 93(define file-position)
 94(define file-read)
 95(define file-select)
 96(define file-size)
 97(define file-stat)
 98(define file-truncate)
 99(define file-unlock)
100(define file-write)
101(define file-type)
102
103(define block-device?)
104(define character-device?)
105(define directory?)
106(define fifo?)
107(define regular-file?)
108(define socket?)
109(define symbolic-link?)
110
111(define fileno/stderr)
112(define fileno/stdin)
113(define fileno/stdout)
114
115(define open-input-file*)
116(define open-output-file*)
117
118(define open/append)
119(define open/binary)
120(define open/creat)
121(define open/excl)
122(define open/fsync)
123(define open/noctty)
124(define open/noinherit)
125(define open/nonblock)
126(define open/rdonly)
127(define open/rdwr)
128(define open/read)
129(define open/sync)
130(define open/text)
131(define open/trunc)
132(define open/write)
133(define open/wronly)
134
135(define perm/irgrp)
136(define perm/iroth)
137(define perm/irusr)
138(define perm/irwxg)
139(define perm/irwxo)
140(define perm/irwxu)
141(define perm/isgid)
142(define perm/isuid)
143(define perm/isvtx)
144(define perm/iwgrp)
145(define perm/iwoth)
146(define perm/iwusr)
147(define perm/ixgrp)
148(define perm/ixoth)
149(define perm/ixusr)
150
151(define port->fileno)
152
153(define seek/cur)
154(define seek/end)
155(define seek/set)
156
157(define set-file-group!)
158(define set-file-owner!)
159(define set-file-permissions!)
160(define set-file-position!)
161(define set-file-times!)
162) ; chicken.file.posix
163
164
165(module chicken.time.posix
166  (seconds->utc-time utc-time->seconds seconds->local-time
167   seconds->string local-time->seconds string->time time->string
168   local-timezone-abbreviation)
169
170(import scheme)
171
172;; These are all set! inside the posix module
173(define seconds->utc-time)
174(define utc-time->seconds)
175(define seconds->local-time)
176(define seconds->string)
177(define local-time->seconds)
178(define string->time)
179(define time->string)
180(define local-timezone-abbreviation)
181) ; chicken.time.posix
182
183
184(module chicken.process
185  (qs system system* process-execute process-fork process-run
186   process-signal process-spawn process-wait call-with-input-pipe
187   call-with-output-pipe close-input-pipe close-output-pipe create-pipe
188   open-input-pipe open-output-pipe with-input-from-pipe
189   with-output-to-pipe process process* process-sleep pipe/buf
190   spawn/overlay spawn/wait spawn/nowait spawn/nowaito spawn/detach
191   process? process-exit-status process-returned-normally? process-input-port
192   process-output-port process-error-port process-id)
193
194(import scheme chicken.base chicken.fixnum chicken.platform)
195
196
197;;; Execute a shell command:
198
199(define (system cmd)
200  (##sys#check-string cmd 'system)
201  (let ((r (##core#inline "C_execute_shell_command" cmd)))
202    (cond ((fx< r 0)
203           (##sys#signal-hook/errno
204            #:process-error (##sys#update-errno) 'system "`system' invocation failed" cmd))
205	  (else r))))
206
207;;; Like `system', but bombs on nonzero return code:
208
209(define (system* str)
210  (let ((n (system str)))
211    (unless (zero? n)
212      (##sys#error "shell invocation failed with non-zero return status" str n))))
213
214
215;;; Quote string for shell:
216
217(define (qs str #!optional (platform (software-version)))
218  (let* ((delim (if (eq? platform 'mingw) #\" #\'))
219	 (escaped (if (eq? platform 'mingw) "\"\"" "'\\''"))
220	 (escaped-parts
221	  (map (lambda (c)
222		 (cond
223		   ((char=? c delim) escaped)
224		   ((char=? c #\nul)
225		    (error 'qs "NUL character can not be represented in shell string" str))
226		   (else (string c))))
227	       (string->list str))))
228    (string-append
229     (string delim)
230     (apply string-append escaped-parts)
231     (string delim))))
232
233
234;; These are all set! inside the posix module
235(define process-execute)
236(define process-fork)
237(define process-run)
238(define process-signal)
239(define process-spawn)
240(define process-wait)
241
242(define call-with-input-pipe)
243(define call-with-output-pipe)
244(define close-input-pipe)
245(define close-output-pipe)
246(define create-pipe)
247(define open-input-pipe)
248(define open-output-pipe)
249(define with-input-from-pipe)
250(define with-output-to-pipe)
251
252(define process)
253(define process*)
254(define process-sleep)
255
256(define process?)
257(define process-exit-status)
258(define process-returned-normally?)
259(define process-input-port)
260(define process-output-port)
261(define process-error-port)
262(define process-id)
263
264(define pipe/buf)
265
266(define spawn/overlay)
267(define spawn/wait)
268(define spawn/nowait)
269(define spawn/nowaito)
270(define spawn/detach)
271) ; chicken.process
272
273
274(module chicken.process.signal
275  (set-alarm! set-signal-mask!
276   make-signal-handler signal-ignore signal-default
277   set-signal-handler! signal-handler ; DEPRECATED
278   signal-mask signal-mask! signal-masked? signal-unmask!
279   signal/abrt signal/alrm signal/break signal/bus signal/chld
280   signal/cont signal/fpe signal/hup signal/ill signal/int signal/io
281   signal/kill signal/pipe signal/prof signal/quit signal/segv
282   signal/stop signal/term signal/trap signal/tstp signal/urg
283   signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu
284   signal/xfsz signals-list)
285
286(import scheme)
287
288;; These are all set! inside the posix module
289(define set-alarm!)
290(define set-signal-handler!) ; DEPRECATED
291(define set-signal-mask!)
292(define signal-handler) ; DEPRECATED
293(define make-signal-handler)
294(define signal-ignore)
295(define signal-default)
296
297(define signal-mask)
298(define signal-mask!)
299(define signal-masked?)
300(define signal-unmask!)
301
302(define signal/abrt)
303(define signal/alrm)
304(define signal/break)
305(define signal/bus)
306(define signal/chld)
307(define signal/cont)
308(define signal/fpe)
309(define signal/hup)
310(define signal/ill)
311(define signal/int)
312(define signal/io)
313(define signal/kill)
314(define signal/pipe)
315(define signal/prof)
316(define signal/quit)
317(define signal/segv)
318(define signal/stop)
319(define signal/term)
320(define signal/trap)
321(define signal/tstp)
322(define signal/urg)
323(define signal/usr1)
324(define signal/usr2)
325(define signal/vtalrm)
326(define signal/winch)
327(define signal/xcpu)
328(define signal/xfsz)
329
330(define signals-list)
331) ; chicken.process.signal
332
333
334(module chicken.process-context.posix
335  (change-directory* set-root-directory!
336   current-effective-group-id current-effective-user-id
337   current-process-id current-group-id current-user-id
338   parent-process-id current-user-name
339   current-effective-user-name create-session
340   process-group-id user-information)
341
342(import scheme)
343
344(define change-directory*)
345(define set-root-directory!)
346(define current-effective-group-id)
347(define current-effective-user-id)
348(define current-group-id)
349(define current-user-id)
350(define current-process-id)
351(define parent-process-id)
352(define current-user-name)
353(define current-effective-user-name)
354(define create-session)
355(define process-group-id)
356(define user-information)
357) ; chicken.process-context.posix
358
359
360;; This module really exports nothing.  It is used to keep all the
361;; posix stuff in one place, in a clean namespace.  The included file
362;; will set! values from the modules defined above.
363(module chicken.posix ()
364
365(import scheme
366	chicken.base
367	chicken.bitwise
368	chicken.condition
369	chicken.fixnum
370	chicken.foreign
371	chicken.memory
372	chicken.pathname
373	chicken.port
374	chicken.process-context
375	chicken.time)
376
377(cond-expand
378  (platform-unix
379   (include "posixunix.scm"))
380  (platform-windows
381   (include "posixwin.scm")))
382
383) ; chicken.posix [internal, no implib generated]
384
385
386(module chicken.errno *
387(import scheme)
388(define (errno) (##sys#errno))
389(define errno/2big _e2big)
390(define errno/acces _eacces)
391(define errno/again _eagain)
392(define errno/badf _ebadf)
393(define errno/busy _ebusy)
394(define errno/child _echild)
395(define errno/deadlk _edeadlk)
396(define errno/dom _edom)
397(define errno/exist _eexist)
398(define errno/fault _efault)
399(define errno/fbig _efbig)
400(define errno/ilseq _eilseq)
401(define errno/intr _eintr)
402(define errno/inval _einval)
403(define errno/io _eio)
404(define errno/isdir _eisdir)
405(define errno/mfile _emfile)
406(define errno/mlink _emlink)
407(define errno/nametoolong _enametoolong)
408(define errno/nfile _enfile)
409(define errno/nodev _enodev)
410(define errno/noent _enoent)
411(define errno/noexec _enoexec)
412(define errno/nolck _enolck)
413(define errno/nomem _enomem)
414(define errno/nospc _enospc)
415(define errno/nosys _enosys)
416(define errno/notdir _enotdir)
417(define errno/notempty _enotempty)
418(define errno/notty _enotty)
419(define errno/nxio _enxio)
420(define errno/perm _eperm)
421(define errno/pipe _epipe)
422(define errno/range _erange)
423(define errno/rofs _erofs)
424(define errno/spipe _espipe)
425(define errno/srch _esrch)
426(define errno/wouldblock _ewouldblock)
427(define errno/xdev _exdev)
428) ; chicken.errno