~ chicken-core (chicken-5) /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-test-lock 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-test-lock)
 99(define file-truncate)
100(define file-unlock)
101(define file-write)
102(define file-type)
103
104(define block-device?)
105(define character-device?)
106(define directory?)
107(define fifo?)
108(define regular-file?)
109(define socket?)
110(define symbolic-link?)
111  
112(define fileno/stderr)
113(define fileno/stdin)
114(define fileno/stdout)
115  
116(define open-input-file*)
117(define open-output-file*)
118  
119(define open/append)
120(define open/binary)
121(define open/creat)
122(define open/excl)
123(define open/fsync)
124(define open/noctty)
125(define open/noinherit)
126(define open/nonblock)
127(define open/rdonly)
128(define open/rdwr)
129(define open/read)
130(define open/sync)
131(define open/text)
132(define open/trunc)
133(define open/write)
134(define open/wronly)
135  
136(define perm/irgrp)
137(define perm/iroth)
138(define perm/irusr)
139(define perm/irwxg)
140(define perm/irwxo)
141(define perm/irwxu)
142(define perm/isgid)
143(define perm/isuid)
144(define perm/isvtx)
145(define perm/iwgrp)
146(define perm/iwoth)
147(define perm/iwusr)
148(define perm/ixgrp)
149(define perm/ixoth)
150(define perm/ixusr)
151  
152(define port->fileno)
153
154(define seek/cur)
155(define seek/end)
156(define seek/set)
157
158(define set-file-group!)
159(define set-file-owner!)
160(define set-file-permissions!)
161(define set-file-position!)
162(define set-file-times!)
163) ; chicken.file.posix
164
165
166(module chicken.time.posix
167  (seconds->utc-time utc-time->seconds seconds->local-time
168   seconds->string local-time->seconds string->time time->string
169   local-timezone-abbreviation)
170
171(import scheme)
172
173;; These are all set! inside the posix module
174(define seconds->utc-time)
175(define utc-time->seconds)
176(define seconds->local-time)
177(define seconds->string)
178(define local-time->seconds)
179(define string->time)
180(define time->string)
181(define local-timezone-abbreviation)
182) ; chicken.time.posix
183
184
185(module chicken.process
186  (qs system system* process-execute process-fork process-run
187   process-signal process-spawn process-wait call-with-input-pipe
188   call-with-output-pipe close-input-pipe close-output-pipe create-pipe
189   open-input-pipe open-output-pipe with-input-from-pipe
190   with-output-to-pipe process process* process-sleep pipe/buf
191   spawn/overlay spawn/wait spawn/nowait spawn/nowaito spawn/detach)
192
193(import scheme chicken.base chicken.fixnum chicken.platform)
194
195
196;;; Execute a shell command:
197
198(define (system cmd)
199  (##sys#check-string cmd 'system)
200  (let ((r (##core#inline "C_execute_shell_command" cmd)))
201    (cond ((fx< r 0)
202           (##sys#signal-hook/errno
203            #:process-error (##sys#update-errno) 'system "`system' invocation failed" cmd))
204	  (else r))))
205
206;;; Like `system', but bombs on nonzero return code:
207
208(define (system* str)
209  (let ((n (system str)))
210    (unless (zero? n)
211      (##sys#error "shell invocation failed with non-zero return status" str n))))
212
213
214;;; Quote string for shell:
215
216(define (qs str #!optional (platform (software-version)))
217  (let* ((delim (if (eq? platform 'mingw32) #\" #\'))
218	 (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''"))
219	 (escaped-parts
220	  (map (lambda (c)
221		 (cond
222		   ((char=? c delim) escaped)
223		   ((char=? c #\nul)
224		    (error 'qs "NUL character can not be represented in shell string" str))
225		   (else (string c))))
226	       (string->list str))))
227    (string-append
228     (string delim)
229     (apply string-append escaped-parts)
230     (string delim))))
231
232
233;; These are all set! inside the posix module
234(define process-execute)
235(define process-fork)
236(define process-run)
237(define process-signal)
238(define process-spawn)
239(define process-wait)
240
241(define call-with-input-pipe)
242(define call-with-output-pipe)
243(define close-input-pipe)
244(define close-output-pipe)
245(define create-pipe)
246(define open-input-pipe)
247(define open-output-pipe)
248(define with-input-from-pipe)
249(define with-output-to-pipe)
250
251(define process)
252(define process*)
253(define process-sleep)
254
255(define pipe/buf)
256
257(define spawn/overlay)
258(define spawn/wait)
259(define spawn/nowait)
260(define spawn/nowaito)
261(define spawn/detach)
262) ; chicken.process
263
264
265(module chicken.process.signal
266  (set-alarm! set-signal-mask!
267   make-signal-handler signal-ignore signal-default
268   set-signal-handler! signal-handler ; DEPRECATED
269   signal-mask signal-mask! signal-masked? signal-unmask!
270   signal/abrt signal/alrm signal/break signal/bus signal/chld
271   signal/cont signal/fpe signal/hup signal/ill signal/int signal/io
272   signal/kill signal/pipe signal/prof signal/quit signal/segv
273   signal/stop signal/term signal/trap signal/tstp signal/urg
274   signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu
275   signal/xfsz signals-list)
276
277(import scheme)
278
279;; These are all set! inside the posix module
280(define set-alarm!)
281(define set-signal-handler!) ; DEPRECATED
282(define set-signal-mask!)
283(define signal-handler) ; DEPRECATED
284(define make-signal-handler)
285(define signal-ignore)
286(define signal-default)
287
288(define signal-mask)
289(define signal-mask!)
290(define signal-masked?)
291(define signal-unmask!)
292
293(define signal/abrt)
294(define signal/alrm)
295(define signal/break)
296(define signal/bus)
297(define signal/chld)
298(define signal/cont)
299(define signal/fpe)
300(define signal/hup)
301(define signal/ill)
302(define signal/int)
303(define signal/io)
304(define signal/kill)
305(define signal/pipe)
306(define signal/prof)
307(define signal/quit)
308(define signal/segv)
309(define signal/stop)
310(define signal/term)
311(define signal/trap)
312(define signal/tstp)
313(define signal/urg)
314(define signal/usr1)
315(define signal/usr2)
316(define signal/vtalrm)
317(define signal/winch)
318(define signal/xcpu)
319(define signal/xfsz)
320
321(define signals-list)
322) ; chicken.process.signal
323
324
325(module chicken.process-context.posix
326  (change-directory* set-root-directory!
327   current-effective-group-id current-effective-user-id
328   current-process-id current-group-id current-user-id
329   parent-process-id current-user-name
330   current-effective-user-name create-session
331   process-group-id user-information)
332
333(import scheme)
334
335(define change-directory*)
336(define set-root-directory!)
337(define current-effective-group-id)
338(define current-effective-user-id)
339(define current-group-id)
340(define current-user-id)
341(define current-process-id)
342(define parent-process-id)
343(define current-user-name)
344(define current-effective-user-name)
345(define create-session)
346(define process-group-id)
347(define user-information)
348) ; chicken.process-context.posix
349
350
351;; This module really exports nothing.  It is used to keep all the
352;; posix stuff in one place, in a clean namespace.  The included file
353;; will set! values from the modules defined above.
354(module chicken.posix ()
355
356(import scheme
357	chicken.base
358	chicken.bitwise
359	chicken.condition
360	chicken.fixnum
361	chicken.foreign
362	chicken.memory
363	chicken.pathname
364	chicken.port
365	chicken.process-context
366	chicken.time)
367
368(cond-expand
369  (platform-unix
370   (include "posixunix.scm"))
371  (platform-windows
372   (include "posixwin.scm")))
373
374) ; chicken.posix [internal, no implib generated]
375
376
377(module chicken.errno *
378(import scheme)
379(define (errno) (##sys#errno))
380(define errno/2big _e2big)
381(define errno/acces _eacces)
382(define errno/again _eagain)
383(define errno/badf _ebadf)
384(define errno/busy _ebusy)
385(define errno/child _echild)
386(define errno/deadlk _edeadlk)
387(define errno/dom _edom)
388(define errno/exist _eexist)
389(define errno/fault _efault)
390(define errno/fbig _efbig)
391(define errno/ilseq _eilseq)
392(define errno/intr _eintr)
393(define errno/inval _einval)
394(define errno/io _eio)
395(define errno/isdir _eisdir)
396(define errno/mfile _emfile)
397(define errno/mlink _emlink)
398(define errno/nametoolong _enametoolong)
399(define errno/nfile _enfile)
400(define errno/nodev _enodev)
401(define errno/noent _enoent)
402(define errno/noexec _enoexec)
403(define errno/nolck _enolck)
404(define errno/nomem _enomem)
405(define errno/nospc _enospc)
406(define errno/nosys _enosys)
407(define errno/notdir _enotdir)
408(define errno/notempty _enotempty)
409(define errno/notty _enotty)
410(define errno/nxio _enxio)
411(define errno/perm _eperm)
412(define errno/pipe _epipe)
413(define errno/range _erange)
414(define errno/rofs _erofs)
415(define errno/spipe _espipe)
416(define errno/srch _esrch)
417(define errno/wouldblock _ewouldblock)
418(define errno/xdev _exdev)
419) ; chicken.errno