Merge branch 'master' of git://factorcode.org/git/factor
commit
a0a0e36739
|
@ -87,6 +87,7 @@ ARTICLE: "io.files" "Basic file operations"
|
||||||
{ $subsection "fs-meta" }
|
{ $subsection "fs-meta" }
|
||||||
{ $subsection "directories" }
|
{ $subsection "directories" }
|
||||||
{ $subsection "delete-move-copy" }
|
{ $subsection "delete-move-copy" }
|
||||||
|
{ $subsection "unique" }
|
||||||
{ $see-also "os" } ;
|
{ $see-also "os" } ;
|
||||||
|
|
||||||
ABOUT: "io.files"
|
ABOUT: "io.files"
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: io.files
|
|
||||||
USING: io.backend io.files.private io hashtables kernel math
|
USING: io.backend io.files.private io hashtables kernel math
|
||||||
memory namespaces sequences strings assocs arrays definitions
|
memory namespaces sequences strings assocs arrays definitions
|
||||||
system combinators splitting sbufs continuations ;
|
system combinators splitting sbufs continuations ;
|
||||||
|
|
||||||
|
IN: io.files
|
||||||
|
|
||||||
! Pathnames
|
! Pathnames
|
||||||
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
|
: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ;
|
||||||
|
|
||||||
|
@ -50,6 +51,19 @@ TUPLE: no-parent-directory path ;
|
||||||
{ [ t ] [ drop ] }
|
{ [ t ] [ drop ] }
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
|
TUPLE: file-info type size permissions modified ;
|
||||||
|
|
||||||
|
HOOK: file-info io-backend ( path -- info )
|
||||||
|
|
||||||
|
SYMBOL: +regular-file+
|
||||||
|
SYMBOL: +directory+
|
||||||
|
SYMBOL: +character-device+
|
||||||
|
SYMBOL: +block-device+
|
||||||
|
SYMBOL: +fifo+
|
||||||
|
SYMBOL: +symbolic-link+
|
||||||
|
SYMBOL: +socket+
|
||||||
|
SYMBOL: +unknown+
|
||||||
|
|
||||||
! File metadata
|
! File metadata
|
||||||
: stat ( path -- directory? permissions length modified )
|
: stat ( path -- directory? permissions length modified )
|
||||||
normalize-pathname (stat) ;
|
normalize-pathname (stat) ;
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel combinators namespaces quotations hashtables
|
USING: kernel combinators namespaces quotations hashtables
|
||||||
sequences assocs arrays inference effects math math.ranges
|
sequences assocs arrays inference effects math math.ranges
|
||||||
arrays.lib shuffle macros bake combinators.cleave ;
|
arrays.lib shuffle macros bake combinators.cleave
|
||||||
|
continuations ;
|
||||||
|
|
||||||
IN: combinators.lib
|
IN: combinators.lib
|
||||||
|
|
||||||
|
@ -167,3 +168,6 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
|
||||||
|
|
||||||
: and? ( obj quot1 quot2 -- ? )
|
: and? ( obj quot1 quot2 -- ? )
|
||||||
>r keep r> rot [ call ] [ 2drop f ] if ; inline
|
>r keep r> rot [ call ] [ 2drop f ] if ; inline
|
||||||
|
|
||||||
|
: retry ( quot n -- )
|
||||||
|
[ drop ] rot compose attempt-all ; inline
|
||||||
|
|
|
@ -53,7 +53,8 @@ M: sqlite-result-set dispose ( result-set -- )
|
||||||
|
|
||||||
M: sqlite-statement bind-statement* ( statement -- )
|
M: sqlite-statement bind-statement* ( statement -- )
|
||||||
dup statement-bound? [ dup reset-statement ] when
|
dup statement-bound? [ dup reset-statement ] when
|
||||||
[ statement-bind-params ] [ statement-handle ] bi sqlite-bind ;
|
[ statement-bind-params ] [ statement-handle ] bi
|
||||||
|
sqlite-bind ;
|
||||||
|
|
||||||
M: sqlite-statement bind-tuple ( tuple statement -- )
|
M: sqlite-statement bind-tuple ( tuple statement -- )
|
||||||
[
|
[
|
||||||
|
@ -64,7 +65,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
|
||||||
[ sql-spec-type ] tri 3array
|
[ sql-spec-type ] tri 3array
|
||||||
] with map
|
] with map
|
||||||
] keep
|
] keep
|
||||||
[ set-statement-bind-params ] keep bind-statement* ;
|
bind-statement ;
|
||||||
|
|
||||||
: last-insert-id ( -- id )
|
: last-insert-id ( -- id )
|
||||||
db get db-handle sqlite3_last_insert_rowid
|
db get db-handle sqlite3_last_insert_rowid
|
||||||
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
USING: io.backend ;
|
||||||
|
IN: io.files.unique.backend
|
||||||
|
|
||||||
|
HOOK: (make-unique-file) io-backend ( path -- stream )
|
||||||
|
HOOK: temporary-path io-backend ( -- path )
|
|
@ -0,0 +1,50 @@
|
||||||
|
USING: help.markup help.syntax io io.nonblocking kernel math
|
||||||
|
io.files.unique.private math.parser io.files ;
|
||||||
|
IN: io.files.unique
|
||||||
|
|
||||||
|
ARTICLE: "unique" "Making and using unique files"
|
||||||
|
"Files:"
|
||||||
|
{ $subsection make-unique-file }
|
||||||
|
{ $subsection with-unique-file }
|
||||||
|
{ $subsection with-temporary-file }
|
||||||
|
"Directories:"
|
||||||
|
{ $subsection make-unique-directory }
|
||||||
|
{ $subsection with-unique-directory }
|
||||||
|
{ $subsection with-temporary-directory } ;
|
||||||
|
|
||||||
|
ABOUT: "unique"
|
||||||
|
|
||||||
|
HELP: make-unique-file ( prefix suffix -- path stream )
|
||||||
|
{ $values { "prefix" "a string" } { "suffix" "a string" }
|
||||||
|
{ "path" "a pathname string" } { "stream" "an output stream" } }
|
||||||
|
{ $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname and a " { $link <writer> } " stream." }
|
||||||
|
{ $errors "Throws an error if a new unique file cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
|
||||||
|
{ $see-also with-unique-file } ;
|
||||||
|
|
||||||
|
HELP: make-unique-directory ( -- path )
|
||||||
|
{ $values { "path" "a pathname string" } }
|
||||||
|
{ $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." }
|
||||||
|
{ $errors "Throws an error if the directory cannot be created after a number of tries. Since each try generates a new random name, the most likely error is incorrect directory permissions on the temporary directory." }
|
||||||
|
{ $see-also with-unique-directory } ;
|
||||||
|
|
||||||
|
HELP: with-unique-file ( quot -- path )
|
||||||
|
{ $values { "quot" "a quotation" } { "path" "a pathname string" } }
|
||||||
|
{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. Returns the full pathname after the stream has been closed." }
|
||||||
|
{ $notes "The unique file will remain after calling this word." }
|
||||||
|
{ $see-also with-temporary-file } ;
|
||||||
|
|
||||||
|
HELP: with-unique-directory ( quot -- path )
|
||||||
|
{ $values { "quot" "a quotation" } { "path" "a pathname string" } }
|
||||||
|
{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. Returns the full pathname after the quotation has been called." }
|
||||||
|
{ $notes "The directory will remain after calling this word." }
|
||||||
|
{ $see-also with-temporary-directory } ;
|
||||||
|
|
||||||
|
HELP: with-temporary-file ( quot -- )
|
||||||
|
{ $values { "quot" "a quotation" } }
|
||||||
|
{ $description "Creates a file with " { $link make-unique-file } " and calls " { $link with-stream } " on the newly created file. The file is deleted after the quotation returns." }
|
||||||
|
{ $see-also with-unique-file } ;
|
||||||
|
|
||||||
|
HELP: with-temporary-directory ( quot -- )
|
||||||
|
{ $values { "quot" "a quotation" } }
|
||||||
|
{ $description "Creates a directory with " { $link make-unique-directory } " and calls " { $link with-directory } " on the newly created directory. The directory is deleted after the quotation returns." }
|
||||||
|
{ $see-also with-unique-directory } ;
|
|
@ -0,0 +1,53 @@
|
||||||
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel math math.bitfields combinators.lib math.parser
|
||||||
|
random sequences sequences.lib continuations namespaces
|
||||||
|
io.files io.backend io.nonblocking io arrays
|
||||||
|
io.files.unique.backend system combinators vocabs.loader ;
|
||||||
|
IN: io.files.unique
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
: random-letter ( -- ch )
|
||||||
|
26 random { CHAR: a CHAR: A } random + ;
|
||||||
|
|
||||||
|
: random-ch ( -- ch )
|
||||||
|
{ t f } random
|
||||||
|
[ 10 random CHAR: 0 + ] [ random-letter ] if ;
|
||||||
|
|
||||||
|
: random-name ( n -- string )
|
||||||
|
[ drop random-ch ] "" map-as ;
|
||||||
|
|
||||||
|
: unique-length ( -- n ) 10 ; inline
|
||||||
|
: unique-retries ( -- n ) 10 ; inline
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: make-unique-file ( prefix suffix -- path stream )
|
||||||
|
temporary-path -rot
|
||||||
|
[
|
||||||
|
unique-length random-name swap 3append path+
|
||||||
|
dup (make-unique-file)
|
||||||
|
] 3curry unique-retries retry ;
|
||||||
|
|
||||||
|
: with-unique-file ( quot -- path )
|
||||||
|
>r f f make-unique-file r> rot [ with-stream ] dip ; inline
|
||||||
|
|
||||||
|
: with-temporary-file ( quot -- )
|
||||||
|
with-unique-file delete-file ; inline
|
||||||
|
|
||||||
|
: make-unique-directory ( -- path )
|
||||||
|
[
|
||||||
|
temporary-path unique-length random-name path+
|
||||||
|
dup make-directory
|
||||||
|
] unique-retries retry ;
|
||||||
|
|
||||||
|
: with-unique-directory ( quot -- path )
|
||||||
|
>r make-unique-directory r>
|
||||||
|
[ with-directory ] curry keep ; inline
|
||||||
|
|
||||||
|
: with-temporary-directory ( quot -- )
|
||||||
|
with-unique-directory delete-tree ; inline
|
||||||
|
|
||||||
|
{
|
||||||
|
{ [ unix? ] [ "io.unix.files.unique" ] }
|
||||||
|
{ [ windows? ] [ "io.windows.files.unique" ] }
|
||||||
|
} cond require
|
|
@ -1,8 +1,9 @@
|
||||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.backend io.nonblocking io.unix.backend io.files io
|
USING: io.backend io.nonblocking io.unix.backend io.files io
|
||||||
unix kernel math continuations math.bitfields byte-arrays
|
unix unix.stat kernel math continuations math.bitfields byte-arrays
|
||||||
alien ;
|
alien combinators combinators.cleave calendar ;
|
||||||
|
|
||||||
IN: io.unix.files
|
IN: io.unix.files
|
||||||
|
|
||||||
M: unix-io cwd
|
M: unix-io cwd
|
||||||
|
@ -67,3 +68,24 @@ M: unix-io delete-directory ( path -- )
|
||||||
|
|
||||||
M: unix-io copy-file ( from to -- )
|
M: unix-io copy-file ( from to -- )
|
||||||
>r dup file-permissions over r> (copy-file) chmod io-error ;
|
>r dup file-permissions over r> (copy-file) chmod io-error ;
|
||||||
|
|
||||||
|
: stat>type ( stat -- type )
|
||||||
|
stat-st_mode {
|
||||||
|
{ [ dup S_ISREG ] [ +regular-file+ ] }
|
||||||
|
{ [ dup S_ISDIR ] [ +directory+ ] }
|
||||||
|
{ [ dup S_ISCHR ] [ +character-device+ ] }
|
||||||
|
{ [ dup S_ISBLK ] [ +block-device+ ] }
|
||||||
|
{ [ dup S_ISFIFO ] [ +fifo+ ] }
|
||||||
|
{ [ dup S_ISLNK ] [ +symbolic-link+ ] }
|
||||||
|
{ [ dup S_ISSOCK ] [ +socket+ ] }
|
||||||
|
{ [ t ] [ +unknown+ ] }
|
||||||
|
} cond nip ;
|
||||||
|
|
||||||
|
M: unix-io file-info ( path -- info )
|
||||||
|
stat* {
|
||||||
|
[ stat>type ]
|
||||||
|
[ stat-st_size ]
|
||||||
|
[ stat-st_mode ]
|
||||||
|
[ stat-st_mtim timespec-sec seconds unix-1970 time+ ]
|
||||||
|
} cleave
|
||||||
|
\ file-info construct-boa ;
|
||||||
|
|
|
@ -0,0 +1,12 @@
|
||||||
|
USING: kernel io.nonblocking io.unix.backend math.bitfields
|
||||||
|
unix io.files.unique.backend ;
|
||||||
|
IN: io.unix.files.unique
|
||||||
|
|
||||||
|
: open-unique-flags ( -- flags )
|
||||||
|
{ O_RDWR O_CREAT O_EXCL } flags ;
|
||||||
|
|
||||||
|
M: unix-io (make-unique-file) ( path -- duplex-stream )
|
||||||
|
open-unique-flags file-mode open dup io-error
|
||||||
|
<writer> ;
|
||||||
|
|
||||||
|
M: unix-io temporary-path ( -- path ) "/tmp" ;
|
|
@ -1,6 +1,6 @@
|
||||||
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
|
USING: io.unix.backend io.unix.files io.unix.sockets io.timeouts
|
||||||
io.unix.launcher io.unix.mmap io.backend combinators namespaces
|
io.unix.launcher io.unix.mmap io.backend
|
||||||
system vocabs.loader sequences ;
|
combinators namespaces system vocabs.loader sequences ;
|
||||||
|
|
||||||
"io.unix." os append require
|
"io.unix." os append require
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,8 @@
|
||||||
|
USING: kernel system io.files.unique.backend ;
|
||||||
|
IN: io.windows.files.unique
|
||||||
|
|
||||||
|
M: windows-io (make-unique-file) ( path -- stream )
|
||||||
|
GENERIC_WRITE CREATE_NEW 0 open-file 0 <writer> ;
|
||||||
|
|
||||||
|
M: windows-io temporary-path ( -- path )
|
||||||
|
"TEMP" os-env ;
|
|
@ -2,8 +2,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types arrays destructors io io.backend
|
USING: alien alien.c-types arrays destructors io io.backend
|
||||||
io.buffers io.files io.nonblocking io.sockets io.binary
|
io.buffers io.files io.nonblocking io.sockets io.binary
|
||||||
io.sockets.impl windows.errors strings io.streams.duplex kernel
|
io.sockets.impl windows.errors strings io.streams.duplex
|
||||||
math namespaces sequences windows windows.kernel32
|
kernel math namespaces sequences windows windows.kernel32
|
||||||
windows.shell32 windows.types windows.winsock splitting
|
windows.shell32 windows.types windows.winsock splitting
|
||||||
continuations math.bitfields ;
|
continuations math.bitfields ;
|
||||||
IN: io.windows
|
IN: io.windows
|
||||||
|
|
|
@ -24,31 +24,10 @@ C-STRUCT: stat
|
||||||
{ "ulong" "unused4" }
|
{ "ulong" "unused4" }
|
||||||
{ "ulong" "unused5" } ;
|
{ "ulong" "unused5" } ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
||||||
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
||||||
|
|
||||||
: stat ( pathname buf -- int ) 3 -rot __xstat ;
|
: stat ( pathname buf -- int ) 3 -rot __xstat ;
|
||||||
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
|
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: S_IFMT OCT: 170000 ; ! These bits determine file type.
|
|
||||||
|
|
||||||
: S_IFDIR OCT: 40000 ; ! Directory.
|
|
||||||
: S_IFCHR OCT: 20000 ; ! Character device.
|
|
||||||
: S_IFBLK OCT: 60000 ; ! Block device.
|
|
||||||
: S_IFREG OCT: 100000 ; ! Regular file.
|
|
||||||
: S_IFIFO OCT: 010000 ; ! FIFO.
|
|
||||||
: S_IFLNK OCT: 120000 ; ! Symbolic link.
|
|
||||||
: S_IFSOCK OCT: 140000 ; ! Socket.
|
|
||||||
|
|
||||||
: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
|
|
||||||
|
|
||||||
: S_ISREG ( mode -- value ) S_IFREG S_ISTYPE ;
|
|
||||||
: S_ISDIR ( mode -- value ) S_IFDIR S_ISTYPE ;
|
|
||||||
: S_ISCHR ( mode -- value ) S_IFCHR S_ISTYPE ;
|
|
||||||
: S_ISBLK ( mode -- value ) S_IFBLK S_ISTYPE ;
|
|
||||||
: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
|
|
||||||
: S_ISLNK ( mode -- value ) S_IFLNK S_ISTYPE ;
|
|
||||||
: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
|
|
||||||
|
|
|
@ -28,27 +28,4 @@ FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
||||||
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
||||||
|
|
||||||
: stat ( pathname buf -- int ) 3 -rot __xstat ;
|
: stat ( pathname buf -- int ) 3 -rot __xstat ;
|
||||||
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
|
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
|
|
||||||
: S_IFMT OCT: 170000 ; ! These bits determine file type.
|
|
||||||
|
|
||||||
: S_IFDIR OCT: 40000 ; ! Directory.
|
|
||||||
: S_IFCHR OCT: 20000 ; ! Character device.
|
|
||||||
: S_IFBLK OCT: 60000 ; ! Block device.
|
|
||||||
: S_IFREG OCT: 100000 ; ! Regular file.
|
|
||||||
: S_IFIFO OCT: 010000 ; ! FIFO.
|
|
||||||
: S_IFLNK OCT: 120000 ; ! Symbolic link.
|
|
||||||
: S_IFSOCK OCT: 140000 ; ! Socket.
|
|
||||||
|
|
||||||
: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
|
|
||||||
|
|
||||||
: S_ISREG ( mode -- value ) S_IFREG S_ISTYPE ;
|
|
||||||
: S_ISDIR ( mode -- value ) S_IFDIR S_ISTYPE ;
|
|
||||||
: S_ISCHR ( mode -- value ) S_IFCHR S_ISTYPE ;
|
|
||||||
: S_ISBLK ( mode -- value ) S_IFBLK S_ISTYPE ;
|
|
||||||
: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
|
|
||||||
: S_ISLNK ( mode -- value ) S_IFLNK S_ISTYPE ;
|
|
||||||
: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
|
|
||||||
|
|
|
@ -28,25 +28,6 @@ C-STRUCT: stat
|
||||||
FUNCTION: int stat ( char* pathname, stat* buf ) ;
|
FUNCTION: int stat ( char* pathname, stat* buf ) ;
|
||||||
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
|
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
: stat-st_atim stat-st_atimespec ;
|
||||||
|
: stat-st_mtim stat-st_mtimespec ;
|
||||||
: S_IFMT OCT: 170000 ; ! These bits determine file type.
|
: stat-st_ctim stat-st_ctimespec ;
|
||||||
|
|
||||||
: S_IFDIR OCT: 40000 ; ! Directory.
|
|
||||||
: S_IFCHR OCT: 20000 ; ! Character device.
|
|
||||||
: S_IFBLK OCT: 60000 ; ! Block device.
|
|
||||||
: S_IFREG OCT: 100000 ; ! Regular file.
|
|
||||||
: S_IFIFO OCT: 010000 ; ! FIFO.
|
|
||||||
: S_IFLNK OCT: 120000 ; ! Symbolic link.
|
|
||||||
: S_IFSOCK OCT: 140000 ; ! Socket.
|
|
||||||
|
|
||||||
: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
|
|
||||||
|
|
||||||
: S_ISREG ( mode -- value ) S_IFREG S_ISTYPE ;
|
|
||||||
: S_ISDIR ( mode -- value ) S_IFDIR S_ISTYPE ;
|
|
||||||
: S_ISCHR ( mode -- value ) S_IFCHR S_ISTYPE ;
|
|
||||||
: S_ISBLK ( mode -- value ) S_IFBLK S_ISTYPE ;
|
|
||||||
: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
|
|
||||||
: S_ISLNK ( mode -- value ) S_IFLNK S_ISTYPE ;
|
|
||||||
: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
|
|
||||||
|
|
|
@ -1,11 +1,76 @@
|
||||||
|
|
||||||
USING: system combinators vocabs.loader ;
|
USING: kernel system combinators alien.syntax alien.c-types
|
||||||
|
math io.unix.backend vocabs.loader ;
|
||||||
|
|
||||||
IN: unix.stat
|
IN: unix.stat
|
||||||
|
|
||||||
{
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
{ [ linux? ] [ "unix.stat.linux" require ] }
|
! File Types
|
||||||
{ [ t ] [ ] }
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
}
|
|
||||||
cond
|
|
||||||
|
|
||||||
|
: S_IFMT OCT: 170000 ; ! These bits determine file type.
|
||||||
|
|
||||||
|
: S_IFDIR OCT: 40000 ; ! Directory.
|
||||||
|
: S_IFCHR OCT: 20000 ; ! Character device.
|
||||||
|
: S_IFBLK OCT: 60000 ; ! Block device.
|
||||||
|
: S_IFREG OCT: 100000 ; ! Regular file.
|
||||||
|
: S_IFIFO OCT: 010000 ; ! FIFO.
|
||||||
|
: S_IFLNK OCT: 120000 ; ! Symbolic link.
|
||||||
|
: S_IFSOCK OCT: 140000 ; ! Socket.
|
||||||
|
|
||||||
|
: S_ISTYPE ( mode mask -- val ) >r S_IFMT bitand r> = ;
|
||||||
|
|
||||||
|
: S_ISREG ( mode -- value ) S_IFREG S_ISTYPE ;
|
||||||
|
: S_ISDIR ( mode -- value ) S_IFDIR S_ISTYPE ;
|
||||||
|
: S_ISCHR ( mode -- value ) S_IFCHR S_ISTYPE ;
|
||||||
|
: S_ISBLK ( mode -- value ) S_IFBLK S_ISTYPE ;
|
||||||
|
: S_ISFIFO ( mode -- value ) S_IFIFO S_ISTYPE ;
|
||||||
|
: S_ISLNK ( mode -- value ) S_IFLNK S_ISTYPE ;
|
||||||
|
: S_ISSOCK ( mode -- value ) S_IFSOCK S_ISTYPE ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
! File Access Permissions
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
! Read, write, execute/search by owner
|
||||||
|
: S_IRWXU OCT: 0000700 ; inline ! rwx mask owner
|
||||||
|
: S_IRUSR OCT: 0000400 ; inline ! r owner
|
||||||
|
: S_IWUSR OCT: 0000200 ; inline ! w owner
|
||||||
|
: S_IXUSR OCT: 0000100 ; inline ! x owner
|
||||||
|
! Read, write, execute/search by group
|
||||||
|
: S_IRWXG OCT: 0000070 ; inline ! rwx mask group
|
||||||
|
: S_IRGRP OCT: 0000040 ; inline ! r group
|
||||||
|
: S_IWGRP OCT: 0000020 ; inline ! w group
|
||||||
|
: S_IXGRP OCT: 0000010 ; inline ! x group
|
||||||
|
! Read, write, execute/search by others
|
||||||
|
: S_IRWXO OCT: 0000007 ; inline ! rwx mask other
|
||||||
|
: S_IROTH OCT: 0000004 ; inline ! r other
|
||||||
|
: S_IWOTH OCT: 0000002 ; inline ! w other
|
||||||
|
: S_IXOTH OCT: 0000001 ; inline ! x other
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
FUNCTION: int chmod ( char* path, mode_t mode ) ;
|
||||||
|
|
||||||
|
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
|
||||||
|
|
||||||
|
FUNCTION: int mkdir ( char* path, mode_t mode ) ;
|
||||||
|
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
<<
|
||||||
|
os
|
||||||
|
{
|
||||||
|
{ "linux" [ "unix.stat.linux" require ] }
|
||||||
|
{ "macosx" [ "unix.stat.macosx" require ] }
|
||||||
|
[ drop ]
|
||||||
|
}
|
||||||
|
case
|
||||||
|
>>
|
||||||
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
: check-status ( n -- ) io-error ;
|
||||||
|
|
||||||
|
: stat* ( pathname -- stat )
|
||||||
|
"stat" <c-object> dup >r
|
||||||
|
stat check-status
|
||||||
|
r> ;
|
||||||
|
|
|
@ -1,37 +1,15 @@
|
||||||
! Copyright (C) 2005, 2007 Slava Pestov.
|
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
IN: unix
|
|
||||||
USING: alien alien.c-types alien.syntax kernel libc structs
|
USING: alien alien.c-types alien.syntax kernel libc structs
|
||||||
math namespaces system combinators vocabs.loader unix.types ;
|
math namespaces system combinators vocabs.loader unix.types ;
|
||||||
|
|
||||||
! ! ! Unix types
|
IN: unix
|
||||||
|
|
||||||
! TYPEDEF: long word
|
|
||||||
! TYPEDEF: ulong uword
|
|
||||||
|
|
||||||
! TYPEDEF: long longword
|
|
||||||
! TYPEDEF: ulong ulongword
|
|
||||||
|
|
||||||
! TYPEDEF: long ssize_t
|
|
||||||
! TYPEDEF: longword blksize_t
|
|
||||||
! TYPEDEF: longword blkcnt_t
|
|
||||||
! TYPEDEF: longlong quad_t
|
|
||||||
! TYPEDEF: ulonglong dev_t
|
|
||||||
! TYPEDEF: uint gid_t
|
|
||||||
TYPEDEF: uint in_addr_t
|
TYPEDEF: uint in_addr_t
|
||||||
! TYPEDEF: ulong ino_t
|
|
||||||
! TYPEDEF: int pid_t
|
|
||||||
TYPEDEF: uint socklen_t
|
TYPEDEF: uint socklen_t
|
||||||
TYPEDEF: uint time_t
|
TYPEDEF: uint time_t
|
||||||
! TYPEDEF: uint uid_t
|
|
||||||
TYPEDEF: ulong size_t
|
TYPEDEF: ulong size_t
|
||||||
! TYPEDEF: ulong u_long
|
|
||||||
! TYPEDEF: uint mode_t
|
|
||||||
! TYPEDEF: uword nlink_t
|
|
||||||
! TYPEDEF: void* caddr_t
|
|
||||||
|
|
||||||
! TYPEDEF: ulong off_t
|
|
||||||
! TYPEDEF-IF: bsd? ulonglong off_t
|
|
||||||
|
|
||||||
C-STRUCT: tm
|
C-STRUCT: tm
|
||||||
{ "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
|
{ "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
|
||||||
|
@ -56,41 +34,6 @@ C-STRUCT: timespec
|
||||||
[ set-timespec-nsec ] keep
|
[ set-timespec-nsec ] keep
|
||||||
[ set-timespec-sec ] keep ;
|
[ set-timespec-sec ] keep ;
|
||||||
|
|
||||||
! ! ! Unix constants
|
|
||||||
|
|
||||||
! File type
|
|
||||||
: S_IFMT OCT: 0170000 ; inline ! type of file
|
|
||||||
: S_IFIFO OCT: 0010000 ; inline ! named pipe (fifo)
|
|
||||||
: S_IFCHR OCT: 0020000 ; inline ! character special
|
|
||||||
: S_IFDIR OCT: 0040000 ; inline ! directory
|
|
||||||
: S_IFBLK OCT: 0060000 ; inline ! block special
|
|
||||||
: S_IFREG OCT: 0100000 ; inline ! regular
|
|
||||||
: S_IFLNK OCT: 0120000 ; inline ! symbolic link
|
|
||||||
: S_IFSOCK OCT: 0140000 ; inline ! socket
|
|
||||||
: S_IFWHT OCT: 0160000 ; inline ! whiteout
|
|
||||||
: S_IFXATTR OCT: 0200000 ; inline ! extended attribute
|
|
||||||
|
|
||||||
! File mode
|
|
||||||
! Read, write, execute/search by owner
|
|
||||||
: S_IRWXU OCT: 0000700 ; inline ! rwx mask owner
|
|
||||||
: S_IRUSR OCT: 0000400 ; inline ! r owner
|
|
||||||
: S_IWUSR OCT: 0000200 ; inline ! w owner
|
|
||||||
: S_IXUSR OCT: 0000100 ; inline ! x owner
|
|
||||||
! Read, write, execute/search by group
|
|
||||||
: S_IRWXG OCT: 0000070 ; inline ! rwx mask group
|
|
||||||
: S_IRGRP OCT: 0000040 ; inline ! r group
|
|
||||||
: S_IWGRP OCT: 0000020 ; inline ! w group
|
|
||||||
: S_IXGRP OCT: 0000010 ; inline ! x group
|
|
||||||
! Read, write, execute/search by others
|
|
||||||
: S_IRWXO OCT: 0000007 ; inline ! rwx mask other
|
|
||||||
: S_IROTH OCT: 0000004 ; inline ! r other
|
|
||||||
: S_IWOTH OCT: 0000002 ; inline ! w other
|
|
||||||
: S_IXOTH OCT: 0000001 ; inline ! x other
|
|
||||||
|
|
||||||
: S_ISUID OCT: 0004000 ; inline ! set user id on execution
|
|
||||||
: S_ISGID OCT: 0002000 ; inline ! set group id on execution
|
|
||||||
: S_ISVTX OCT: 0001000 ; inline ! sticky bit
|
|
||||||
|
|
||||||
: PROT_NONE 0 ; inline
|
: PROT_NONE 0 ; inline
|
||||||
: PROT_READ 1 ; inline
|
: PROT_READ 1 ; inline
|
||||||
: PROT_WRITE 2 ; inline
|
: PROT_WRITE 2 ; inline
|
||||||
|
@ -113,7 +56,6 @@ LIBRARY: libc
|
||||||
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
|
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
|
||||||
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
|
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
|
||||||
FUNCTION: int chdir ( char* path ) ;
|
FUNCTION: int chdir ( char* path ) ;
|
||||||
FUNCTION: int chmod ( char* path, mode_t mode ) ;
|
|
||||||
FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
|
FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
|
||||||
FUNCTION: int chroot ( char* path ) ;
|
FUNCTION: int chroot ( char* path ) ;
|
||||||
FUNCTION: void close ( int fd ) ;
|
FUNCTION: void close ( int fd ) ;
|
||||||
|
@ -124,7 +66,6 @@ FUNCTION: int execv ( char* path, char** argv ) ;
|
||||||
FUNCTION: int execvp ( char* path, char** argv ) ;
|
FUNCTION: int execvp ( char* path, char** argv ) ;
|
||||||
FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
|
FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
|
||||||
FUNCTION: int fchdir ( int fd ) ;
|
FUNCTION: int fchdir ( int fd ) ;
|
||||||
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
|
|
||||||
FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
|
FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
|
||||||
FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
|
FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;
|
||||||
FUNCTION: int flock ( int fd, int operation ) ;
|
FUNCTION: int flock ( int fd, int operation ) ;
|
||||||
|
@ -150,7 +91,6 @@ FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ;
|
||||||
FUNCTION: int listen ( int s, int backlog ) ;
|
FUNCTION: int listen ( int s, int backlog ) ;
|
||||||
FUNCTION: tm* localtime ( time_t* clock ) ;
|
FUNCTION: tm* localtime ( time_t* clock ) ;
|
||||||
FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
|
FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ;
|
||||||
FUNCTION: int mkdir ( char* path, mode_t mode ) ;
|
|
||||||
FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
|
FUNCTION: void* mmap ( void* addr, size_t len, int prot, int flags, int fd, off_t offset ) ;
|
||||||
FUNCTION: int munmap ( void* addr, size_t len ) ;
|
FUNCTION: int munmap ( void* addr, size_t len ) ;
|
||||||
FUNCTION: uint ntohl ( uint n ) ;
|
FUNCTION: uint ntohl ( uint n ) ;
|
||||||
|
|
Loading…
Reference in New Issue