diff --git a/NEWS b/NEWS index 01e8e60..ba6b7ce 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,6 @@ version 0.6 * +New scsh libraries: file-mode version 0.5 2003-11-19 * New s48 libraries: procedure-tables. diff --git a/scsh/file-mode/AUTHORS b/scsh/file-mode/AUTHORS new file mode 100644 index 0000000..2ba5fe4 --- /dev/null +++ b/scsh/file-mode/AUTHORS @@ -0,0 +1,2 @@ +Richard Kelsey (port to sunterlib by Martin Gasbichler) + diff --git a/scsh/file-mode/BLURB b/scsh/file-mode/BLURB new file mode 100644 index 0000000..8345244 --- /dev/null +++ b/scsh/file-mode/BLURB @@ -0,0 +1 @@ +file-mode: Data type for file mode (copied from Scheme 48) diff --git a/scsh/file-mode/README b/scsh/file-mode/README new file mode 100644 index 0000000..78107a9 --- /dev/null +++ b/scsh/file-mode/README @@ -0,0 +1,55 @@ +The structure FILE-MODE implements a data type for file modes. The +code is copied verbatim from Scheme 48 0.57. + + +A file mode is a boxed integer representing a file protection mask. + + * (file-mode permission-name ...) -> file-mode syntax + * (file-mode? x) -> boolean + * (file-mode+ file-mode ...) -> file-mode + * (file-mode- file-mode0 file-mode1) -> file-mode + +FILE-MODE is syntax for creating file modes. The mode-names are listed +below. FILE-MODE? is a predicate for file modes. FILE-MODE+ returns a +mode that contains all of permissions of its arguments. FILE-MODE- +returns a mode that has all of the permissions of FILE-MODE0 that are +not in FILE-MODE1. + + * (file-mode=? file-mode0 file-mode1) -> boolean + * (file-mode<=? file-mode0 file-mode1) -> boolean + * (file-mode>=? file-mode0 file-mode1) -> boolean + +FILE-MODE=? returns true if the two modes are exactly the +same. FILE-MODE<=? returns true if FILE-MODE0 has a subset of the +permissions of FILE-MODE1. FILE-MODE>=? is FILE-MODE<=? with the +arguments reversed. + + * (file-mode->integer file-mode) -> integer + * (integer->file-mode integer) -> file-mode + +INTEGER->FILE-MODE and FILE-MODE->INTEGER translate file modes to and +from the classic Unix file mode masks. These may not be the masks used +by the underlying OS. + + Permission name Bit mask + set-uid #o4000 set user id when executing + set-gid #o2000 set group id when executing + owner-read #o0400 read by owner + owner-write #o0200 write by owner + owner-exec #o0100 execute (or search) by owner + group-read #o0040 read by group + group-write #o0020 write by group + group-exec #o0010 execute (or search) by group + other-read #o0004 read by others + other-write #o0002 write by others + other-exec #o0001 execute (or search) by others + + Names for sets of permissions + owner #o0700 read, write, and execute by owner + group #o0070 read, write, and execute by group + other #o0007 read, write, and execute by others + read #o0444 read by anyone + write #o0222 write by anyone + exec #o0111 execute by anyone + all #o0777 anything by anyone + diff --git a/scsh/file-mode/file-mode.scm b/scsh/file-mode/file-mode.scm new file mode 100644 index 0000000..94eb544 --- /dev/null +++ b/scsh/file-mode/file-mode.scm @@ -0,0 +1,100 @@ +; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING. + + +(define-record-type file-mode :file-mode + (really-make-file-mode value) + file-mode? + (value file-mode->integer)) + +(define-record-discloser :file-mode + (lambda (file-mode) + (list 'file-mode + (string-append "0" + (number->string (file-mode->integer file-mode) + 8))))) + + +; STUFF can be a number (#o644), a string ("rwxr--r--"), or ??? +; Or should there be another macro? +; +; For now it has to be a number + +(define (integer->file-mode stuff) + (cond ((and (integer? stuff) + (<= 0 stuff) + (<= stuff #o7777)) + (really-make-file-mode stuff)) + (else + (error "invalid argument to integer->file-mode" stuff)))) + +; Arithmetic + +(define (file-mode+ . modes) + (do ((i 0 (bitwise-ior i (file-mode->integer (car modes)))) + (modes modes (cdr modes))) + ((null? modes) + (integer->file-mode i)))) + +(define (file-mode- mode1 mode2) + (integer->file-mode (bitwise-and (file-mode->integer mode1) + (bitwise-not (file-mode->integer mode2))))) + +; Comparisons + +(define (file-mode=? mode1 mode2) + (= (file-mode->integer mode1) + (file-mode->integer mode2))) + +(define (file-mode<=? mode1 mode2) + (= 0 (bitwise-and (file-mode->integer mode1) + (bitwise-not (file-mode->integer mode2))))) + +(define (file-mode>=? mode1 mode2) + (file-mode<=? mode2 mode1)) + +; Names for various permissions + +(define-syntax file-mode + (lambda (e r c) + (let* ((names '((set-uid . #o4000) + (set-gid . #o2000) + + (owner-read . #o0400) + (owner-write . #o0200) + (owner-exec . #o0100) + (owner . #o0700) + + (group-read . #o0040) + (group-write . #o0020) + (group-exec . #o0010) + (group . #o0070) + + (other-read . #o0004) + (other-write . #o0002) + (other-exec . #o0001) + (other . #o0007) + + (read . #o0444) + (write . #o0222) + (exec . #o0111) + (all . #o0777))) + (lookup (lambda (name) + (let loop ((names names)) + (cond ((null? names) + #f) + ((c name (caar names)) + (cdar names)) + (else + (loop (cdr names)))))))) + (if (or (null? (cdr e)) + (not (pair? (cdr e)))) + e + (let loop ((todo (cdr e)) (mask 0)) + (cond ((null? todo) + `(,(r 'integer->file-mode) ,mask)) + ((and (pair? todo) + (lookup (car todo))) + => (lambda (i) + (loop (cdr todo) (bitwise-ior i mask)))) + (else + e))))))) diff --git a/scsh/file-mode/interfaces.scm b/scsh/file-mode/interfaces.scm new file mode 100644 index 0000000..1e95a67 --- /dev/null +++ b/scsh/file-mode/interfaces.scm @@ -0,0 +1,6 @@ +(define-interface file-modes-interface + (export file-mode? + (file-mode :syntax) + file-mode+ file-mode- + file-mode=? file-mode<=? file-mode>=? + file-mode->integer integer->file-mode)) diff --git a/scsh/file-mode/packages.scm b/scsh/file-mode/packages.scm new file mode 100644 index 0000000..541c3c7 --- /dev/null +++ b/scsh/file-mode/packages.scm @@ -0,0 +1,7 @@ +(define-structure file-modes file-modes-interface + (open scheme + define-record-types + signals + bitwise) + (for-syntax (open scheme bitwise)) + (files file-mode)) \ No newline at end of file