/usr/share/scsh-0.6/scsh/fdports.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | ;;; Copyright (c) 1993 by Olin Shivers.
(define (fd/port? x)
(or (and (integer? x) (>= x 0))
(output-port? x)
(input-port? x)))
;;; Moves an i/o handle FD/PORT to fd TARGET.
;;; - If FD/PORT is a file descriptor, this is dup2(); close().
;;; - If FD/PORT is a port, this shifts the port's underlying file descriptor
;;; to TARGET, as above, closing the old one. Port's revealed count is
;;; set to 1.
;;; TARGET is evicted before the shift -- if there is a port allocated to
;;; file descriptor TARGET, it will be shifted to another file descriptor.
(define (move->fdes fd/port target)
(let ((doit (lambda (fd)
(if (not (= fd target))
(begin (evict-ports target) ; Evicts any ports at TARGET.
(%dup2 fd target))))))
(cond ((integer? fd/port)
(doit fd/port)
target)
((fdport? fd/port)
(sleazy-call/fdes fd/port doit)
(if (%move-fdport target fd/port 1)
(error "fdport shift failed."))
fd/port)
(else (error "Argument not fdport or file descriptor" fd/port)))))
(define (input-source? fd/port)
(check-arg fd/port? fd/port input-source?)
(or (input-port? fd/port)
(and (integer? fd/port)
(let ((access (bitwise-and open/access-mask (fdes-status fd/port))))
(or (= access open/read)
(= access open/read+write))))))
(define (output-source? fd/port)
(check-arg fd/port? fd/port output-source?)
(or (output-port? fd/port)
(and (integer? fd/port)
(let ((access (bitwise-and open/access-mask (fdes-status fd/port))))
(or (= access open/write)
(= access open/read+write))))))
;;; If FD/PORT is a file descriptor, returns a file descriptor.
;;; If FD/PORT is a port, returns a port.
(define (dup fd/port . maybe-target)
(check-arg fd/port? fd/port dup)
(apply (cond ((integer? fd/port) dup->fdes)
((input-port? fd/port) dup->inport)
((output-port? fd/port) dup->outport))
fd/port maybe-target))
(define (dup->fdes fd/port . maybe-target)
(check-arg fd/port? fd/port dup->fdes)
(if (pair? maybe-target)
(let ((target (car maybe-target)))
(close-fdes target) ; Thus evicting any port there.
(sleazy-call/fdes fd/port (lambda (fd) (%dup2 fd target))))
(sleazy-call/fdes fd/port %dup)))
(define (dup->inport fd/port . maybe-target)
(apply really-dup->port make-input-fdport fd/port maybe-target))
(define (dup->outport fd/port . maybe-target)
(apply really-dup->port make-output-fdport fd/port maybe-target))
(define (really-dup->port port-maker fd/port . maybe-target)
(let ((fd (apply dup->fdes fd/port maybe-target)))
(port-maker fd (if (null? maybe-target) 0 1))))
;;; Not exported.
(define (shell-open path flags fdes)
(move->fdes (open-fdes (stringify path) flags #o666) fdes))
(define open/create+trunc
(bitwise-ior open/write (bitwise-ior open/create open/truncate)))
(define open/write+append+create
(bitwise-ior open/write
(bitwise-ior open/append open/create)))
|