Merge branch 'master' of git://factorcode.org/git/factor
commit
a4f1d4f243
|
@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ;
|
|||
|
||||
\ serve-file NOTICE add-input-logging
|
||||
|
||||
: file. ( name dirp -- )
|
||||
[ "/" append ] when
|
||||
: file. ( name -- )
|
||||
dup link-info directory? [ "/" append ] when
|
||||
dup <a =href a> escape-string write </a> ;
|
||||
|
||||
: directory. ( path -- )
|
||||
|
@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
|
|||
[ <h1> file-name escape-string write </h1> ]
|
||||
[
|
||||
<ul>
|
||||
directory sort-keys
|
||||
[ <li> file. </li> ] assoc-each
|
||||
directory-files [ <li> file. </li> ] each
|
||||
</ul>
|
||||
] bi
|
||||
] simple-page ;
|
||||
|
|
|
@ -19,11 +19,14 @@ DEFER: add-child-monitor
|
|||
|
||||
: add-child-monitors ( path -- )
|
||||
#! We yield since this directory scan might take a while.
|
||||
directory* [ first add-child-monitor ] each yield ;
|
||||
dup [
|
||||
[ append-path ] with map
|
||||
[ add-child-monitor ] each yield
|
||||
] with-directory-files ;
|
||||
|
||||
: add-child-monitor ( path -- )
|
||||
notify? [ dup { +add-file+ } monitor tget queue-change ] when
|
||||
qualify-path dup link-info type>> +directory+ eq? [
|
||||
qualify-path dup link-info directory? [
|
||||
[ add-child-monitors ]
|
||||
[
|
||||
[
|
||||
|
|
|
@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar
|
|||
io.encodings.binary accessors sequences strings system
|
||||
io.files.private destructors vocabs.loader calendar.unix
|
||||
unix.stat alien.c-types arrays unix.users unix.groups
|
||||
environment ;
|
||||
environment fry io.encodings.utf8 alien.strings ;
|
||||
IN: io.unix.files
|
||||
|
||||
M: unix cwd ( -- path )
|
||||
|
@ -138,6 +138,27 @@ os {
|
|||
{ linux [ ] }
|
||||
} case
|
||||
|
||||
: with-unix-directory ( path quot -- )
|
||||
[ opendir dup [ (io-error) ] unless ] dip
|
||||
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
|
||||
|
||||
: find-next-file ( DIR* -- byte-array )
|
||||
"dirent" <c-object>
|
||||
f <void*>
|
||||
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
|
||||
*void* [ drop f ] unless ;
|
||||
|
||||
M: unix >directory-entry ( byte-array -- directory-entry )
|
||||
[ dirent-d_name utf8 alien>string ]
|
||||
[ dirent-d_type ] bi directory-entry boa ;
|
||||
|
||||
M: unix (directory-entries) ( path -- seq )
|
||||
[
|
||||
'[ _ find-next-file dup ]
|
||||
[ >directory-entry ]
|
||||
[ drop ] produce
|
||||
] with-unix-directory ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: stat-mode ( path -- mode )
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types io.binary io.backend io.files io.buffers
|
||||
io.windows kernel math splitting
|
||||
io.windows kernel math splitting fry alien.strings
|
||||
windows windows.kernel32 windows.time calendar combinators
|
||||
math.functions sequences namespaces make words symbols system
|
||||
io.ports destructors accessors math.bitwise ;
|
||||
io.ports destructors accessors math.bitwise continuations
|
||||
windows.errors arrays ;
|
||||
IN: io.windows.files
|
||||
|
||||
: open-file ( path access-mode create-mode flags -- handle )
|
||||
|
@ -113,8 +114,35 @@ M: windows delete-directory ( path -- )
|
|||
normalize-path
|
||||
RemoveDirectory win32-error=0/f ;
|
||||
|
||||
M: windows normalize-directory ( string -- string )
|
||||
normalize-path "\\" ?tail drop "\\*" append ;
|
||||
M: windows >directory-entry ( byte-array -- directory-entry )
|
||||
[ WIN32_FIND_DATA-cFileName utf16n alien>string ]
|
||||
[ WIN32_FIND_DATA-dwFileAttributes ]
|
||||
bi directory-entry boa ;
|
||||
|
||||
: find-first-file ( path -- WIN32_FIND_DATA handle )
|
||||
"WIN32_FIND_DATA" <c-object> tuck
|
||||
FindFirstFile
|
||||
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
|
||||
|
||||
: find-next-file ( path -- WIN32_FIND_DATA/f )
|
||||
"WIN32_FIND_DATA" <c-object> tuck
|
||||
FindNextFile 0 = [
|
||||
GetLastError ERROR_NO_MORE_FILES = [
|
||||
win32-error
|
||||
] unless drop f
|
||||
] when ;
|
||||
|
||||
M: windows (directory-entries) ( path -- seq )
|
||||
"\\" ?tail drop "\\*" append
|
||||
find-first-file [ >directory-entry ] dip
|
||||
[
|
||||
'[
|
||||
[ _ find-next-file dup ]
|
||||
[ >directory-entry ]
|
||||
[ drop ] produce
|
||||
over name>> "." = [ nip ] [ swap prefix ] if
|
||||
]
|
||||
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
|
||||
|
||||
SYMBOLS: +read-only+ +hidden+ +system+
|
||||
+archive+ +device+ +normal+ +temporary+
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel system io.files.unique.backend
|
||||
windows.kernel32 io.windows io.windows.files io.ports windows
|
||||
destructors ;
|
||||
destructors environment ;
|
||||
IN: io.windows.files.unique
|
||||
|
||||
M: windows (make-unique-file) ( path -- )
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: io.windows.launcher.nt.tests
|
||||
USING: io.launcher tools.test calendar accessors
|
||||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
IN: io.windows.launcher.nt.tests
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
USE: system
|
||||
USE: prettyprint
|
||||
os-envs .
|
||||
USE: system
|
||||
USE: prettyprint
|
||||
USE: environment
|
||||
os-envs .
|
||||
|
|
|
@ -83,7 +83,7 @@ SYMBOL: log-files
|
|||
|
||||
: (rotate-logs) ( -- )
|
||||
(close-logs)
|
||||
log-root directory [ drop rotate-log ] assoc-each ;
|
||||
log-root directory-files [ rotate-log ] each ;
|
||||
|
||||
: log-server-loop ( -- )
|
||||
receive unclip {
|
||||
|
|
|
@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback
|
|||
|
||||
\ (exists?) { string } { object } define-primitive
|
||||
|
||||
\ (directory) { string } { array } define-primitive
|
||||
|
||||
\ gc { } { } define-primitive
|
||||
|
||||
\ gc-stats { } { array } define-primitive
|
||||
|
|
|
@ -14,8 +14,7 @@ IN: tools.vocabs
|
|||
: vocab-tests-dir ( vocab -- paths )
|
||||
dup vocab-dir "tests" append-path vocab-append-path dup [
|
||||
dup exists? [
|
||||
dup directory keys
|
||||
[ ".factor" tail? ] filter
|
||||
dup directory-files [ ".factor" tail? ] filter
|
||||
[ append-path ] with map
|
||||
] [ drop f ] if
|
||||
] [ drop f ] if ;
|
||||
|
@ -208,11 +207,15 @@ M: vocab-link summary vocab-summary ;
|
|||
dup vocab-authors-path set-vocab-file-contents ;
|
||||
|
||||
: subdirs ( dir -- dirs )
|
||||
directory [ second ] filter keys natural-sort ;
|
||||
[
|
||||
[ link-info directory? ] filter
|
||||
] with-directory-files natural-sort ;
|
||||
|
||||
: (all-child-vocabs) ( root name -- vocabs )
|
||||
[ vocab-dir append-path subdirs ] keep
|
||||
[
|
||||
vocab-dir append-path dup exists?
|
||||
[ subdirs ] [ drop { } ] if
|
||||
] keep [
|
||||
swap [ "." swap 3append ] with map
|
||||
] unless-empty ;
|
||||
|
||||
|
|
|
@ -3,8 +3,6 @@
|
|||
USING: alien.syntax combinators system vocabs.loader ;
|
||||
IN: unix
|
||||
|
||||
! FreeBSD
|
||||
|
||||
: MAXPATHLEN 1024 ; inline
|
||||
|
||||
: O_RDONLY HEX: 0000 ; inline
|
||||
|
@ -85,6 +83,16 @@ C-STRUCT: passwd
|
|||
: SEEK_CUR 1 ; inline
|
||||
: SEEK_END 2 ; inline
|
||||
|
||||
: DT_UNKNOWN 0 ; inline
|
||||
: DT_FIFO 1 ; inline
|
||||
: DT_CHR 2 ; inline
|
||||
: DT_DIR 4 ; inline
|
||||
: DT_BLK 6 ; inline
|
||||
: DT_REG 8 ; inline
|
||||
: DT_LNK 10 ; inline
|
||||
: DT_SOCK 12 ; inline
|
||||
: DT_WHT 14 ; inline
|
||||
|
||||
os {
|
||||
{ macosx [ "unix.bsd.macosx" require ] }
|
||||
{ freebsd [ "unix.bsd.freebsd" require ] }
|
||||
|
|
|
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
|
|||
{ "void*" "addr" }
|
||||
{ "addrinfo*" "next" } ;
|
||||
|
||||
C-STRUCT: dirent
|
||||
{ "u_int32_t" "d_fileno" }
|
||||
{ "u_int16_t" "d_reclen" }
|
||||
{ "u_int8_t" "d_type" }
|
||||
{ "u_int8_t" "d_namlen" }
|
||||
{ { "char" 256 } "d_name" } ;
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
|
|
@ -13,6 +13,32 @@ C-STRUCT: addrinfo
|
|||
{ "void*" "addr" }
|
||||
{ "addrinfo*" "next" } ;
|
||||
|
||||
: _UTX_USERSIZE 256 ; inline
|
||||
: _UTX_LINESIZE 32 ; inline
|
||||
: _UTX_IDSIZE 4 ; inline
|
||||
: _UTX_HOSTSIZE 256 ; inline
|
||||
|
||||
C-STRUCT: utmpx
|
||||
{ { "char" _UTX_USERSIZE } "ut_user" }
|
||||
{ { "char" _UTX_IDSIZE } "ut_id" }
|
||||
{ { "char" _UTX_LINESIZE } "ut_line" }
|
||||
{ "pid_t" "ut_pid" }
|
||||
{ "short" "ut_type" }
|
||||
{ "timeval" "ut_tv" }
|
||||
{ { "char" _UTX_HOSTSIZE } "ut_host" }
|
||||
{ { "uint" 16 } "ut_pad" } ;
|
||||
|
||||
: __DARWIN_MAXPATHLEN 1024 ; inline
|
||||
: __DARWIN_MAXNAMELEN 255 ; inline
|
||||
: __DARWIN_MAXNAMELEN+1 255 ; inline
|
||||
|
||||
C-STRUCT: dirent
|
||||
{ "ino_t" "d_ino" }
|
||||
{ "__uint16_t" "d_reclen" }
|
||||
{ "__uint8_t" "d_type" }
|
||||
{ "__uint8_t" "d_namlen" }
|
||||
{ { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
@ -117,18 +143,3 @@ C-STRUCT: addrinfo
|
|||
: ETIME 101 ; inline
|
||||
: EOPNOTSUPP 102 ; inline
|
||||
: ENOPOLICY 103 ; inline
|
||||
|
||||
: _UTX_USERSIZE 256 ; inline
|
||||
: _UTX_LINESIZE 32 ; inline
|
||||
: _UTX_IDSIZE 4 ; inline
|
||||
: _UTX_HOSTSIZE 256 ; inline
|
||||
|
||||
C-STRUCT: utmpx
|
||||
{ { "char" _UTX_USERSIZE } "ut_user" }
|
||||
{ { "char" _UTX_IDSIZE } "ut_id" }
|
||||
{ { "char" _UTX_LINESIZE } "ut_line" }
|
||||
{ "pid_t" "ut_pid" }
|
||||
{ "short" "ut_type" }
|
||||
{ "timeval" "ut_tv" }
|
||||
{ { "char" _UTX_HOSTSIZE } "ut_host" }
|
||||
{ { "uint" 16 } "ut_pad" } ;
|
||||
|
|
|
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
|
|||
{ "void*" "addr" }
|
||||
{ "addrinfo*" "next" } ;
|
||||
|
||||
C-STRUCT: dirent
|
||||
{ "__uint32_t" "d_fileno" }
|
||||
{ "__uint16_t" "d_reclen" }
|
||||
{ "__uint8_t" "d_type" }
|
||||
{ "__uint8_t" "d_namlen" }
|
||||
{ { "char" 256 } "d_name" } ;
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
|
|
@ -13,6 +13,13 @@ C-STRUCT: addrinfo
|
|||
{ "char*" "canonname" }
|
||||
{ "addrinfo*" "next" } ;
|
||||
|
||||
C-STRUCT: dirent
|
||||
{ "__uint32_t" "d_fileno" }
|
||||
{ "__uint16_t" "d_reclen" }
|
||||
{ "__uint8_t" "d_type" }
|
||||
{ "__uint8_t" "d_namlen" }
|
||||
{ { "char" 256 } "d_name" } ;
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
|
|
@ -1,6 +1,4 @@
|
|||
|
||||
USING: alien.syntax ;
|
||||
|
||||
IN: unix.linux.fs
|
||||
|
||||
: MS_RDONLY 1 ; ! Mount read-only.
|
||||
|
@ -22,4 +20,4 @@ FUNCTION: int mount
|
|||
|
||||
! FUNCTION: int umount2 ( char* file, int flags ) ;
|
||||
|
||||
FUNCTION: int umount ( char* file ) ;
|
||||
FUNCTION: int umount ( char* file ) ;
|
||||
|
|
|
@ -92,6 +92,13 @@ C-STRUCT: passwd
|
|||
{ "char*" "pw_dir" }
|
||||
{ "char*" "pw_shell" } ;
|
||||
|
||||
C-STRUCT: dirent
|
||||
{ "__ino_t" "d_ino" }
|
||||
{ "__off_t" "d_off" }
|
||||
{ "ushort" "d_reclen" }
|
||||
{ "uchar" "d_type" }
|
||||
{ { "char" 256 } "d_name" } ;
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
|
|
@ -1,6 +1,4 @@
|
|||
|
||||
USING: kernel alien.syntax math ;
|
||||
|
||||
IN: unix.stat
|
||||
|
||||
! Ubuntu 8.04 32-bit
|
||||
|
@ -31,3 +29,14 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
|||
|
||||
: stat ( pathname buf -- int ) 3 -rot __xstat ;
|
||||
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
|
||||
|
||||
C-STRUCT: statfs
|
||||
{ "long" "f_type" }
|
||||
{ "long" "f_bsize" }
|
||||
{ "long" "f_blocks" }
|
||||
{ "long" "f_bfree" }
|
||||
{ "long" "f_bavail" }
|
||||
{ "long" "f_files" }
|
||||
{ "long" "f_ffree" }
|
||||
{ "fsid_t" "f_fsid" }
|
||||
{ "long" "f_namelen" } ;
|
||||
|
|
|
@ -1,6 +1,5 @@
|
|||
|
||||
USING: kernel alien.syntax math ;
|
||||
|
||||
USING: kernel alien.syntax math sequences unix
|
||||
alien.c-types arrays accessors combinators ;
|
||||
IN: unix.stat
|
||||
|
||||
! Ubuntu 7.10 64-bit
|
||||
|
@ -29,3 +28,22 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
|||
|
||||
: stat ( pathname buf -- int ) 1 -rot __xstat ;
|
||||
: lstat ( pathname buf -- int ) 1 -rot __lxstat ;
|
||||
|
||||
TYPEDEF: ssize_t __SWORD_TYPE
|
||||
TYPEDEF: ulonglong __fsblkcnt64_t
|
||||
TYPEDEF: ulonglong __fsfilcnt64_t
|
||||
|
||||
C-STRUCT: statfs64
|
||||
{ "__SWORD_TYPE" "f_type" }
|
||||
{ "__SWORD_TYPE" "f_bsize" }
|
||||
{ "__fsblkcnt64_t" "f_blocks" }
|
||||
{ "__fsblkcnt64_t" "f_bfree" }
|
||||
{ "__fsblkcnt64_t" "f_bavail" }
|
||||
{ "__fsfilcnt64_t" "f_files" }
|
||||
{ "__fsfilcnt64_t" "f_ffree" }
|
||||
{ "__fsid_t" "f_fsid" }
|
||||
{ "__SWORD_TYPE" "f_namelen" }
|
||||
{ "__SWORD_TYPE" "f_frsize" }
|
||||
{ { "__SWORD_TYPE" 5 } "f_spare" } ;
|
||||
|
||||
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
|
||||
|
|
|
@ -1,11 +1,14 @@
|
|||
|
||||
USING: layouts combinators vocabs.loader ;
|
||||
|
||||
USING: alien.syntax layouts combinators vocabs.loader ;
|
||||
IN: unix.stat
|
||||
|
||||
C-STRUCT: fsid
|
||||
{ { "int" 2 } "__val" } ;
|
||||
|
||||
TYPEDEF: fsid __fsid_t
|
||||
TYPEDEF: fsid fsid_t
|
||||
|
||||
cell-bits
|
||||
{
|
||||
{
|
||||
{ 32 [ "unix.stat.linux.32" require ] }
|
||||
{ 64 [ "unix.stat.linux.64" require ] }
|
||||
}
|
||||
case
|
||||
} case
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
USING: kernel alien.syntax math ;
|
||||
USING: kernel alien.syntax math unix math.bitwise
|
||||
alien.c-types alien sequences grouping accessors combinators ;
|
||||
IN: unix.stat
|
||||
|
||||
! Mac OS X ppc
|
||||
|
@ -30,3 +31,114 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
|
|||
|
||||
: stat ( path buf -- n ) stat64 ;
|
||||
: lstat ( path buf -- n ) lstat64 ;
|
||||
|
||||
: MNT_RDONLY HEX: 00000001 ; inline
|
||||
: MNT_SYNCHRONOUS HEX: 00000002 ; inline
|
||||
: MNT_NOEXEC HEX: 00000004 ; inline
|
||||
: MNT_NOSUID HEX: 00000008 ; inline
|
||||
: MNT_NODEV HEX: 00000010 ; inline
|
||||
: MNT_UNION HEX: 00000020 ; inline
|
||||
: MNT_ASYNC HEX: 00000040 ; inline
|
||||
: MNT_EXPORTED HEX: 00000100 ; inline
|
||||
: MNT_QUARANTINE HEX: 00000400 ; inline
|
||||
: MNT_LOCAL HEX: 00001000 ; inline
|
||||
: MNT_QUOTA HEX: 00002000 ; inline
|
||||
: MNT_ROOTFS HEX: 00004000 ; inline
|
||||
: MNT_DOVOLFS HEX: 00008000 ; inline
|
||||
: MNT_DONTBROWSE HEX: 00100000 ; inline
|
||||
: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline
|
||||
: MNT_AUTOMOUNTED HEX: 00400000 ; inline
|
||||
: MNT_JOURNALED HEX: 00800000 ; inline
|
||||
: MNT_NOUSERXATTR HEX: 01000000 ; inline
|
||||
: MNT_DEFWRITE HEX: 02000000 ; inline
|
||||
: MNT_MULTILABEL HEX: 04000000 ; inline
|
||||
: MNT_NOATIME HEX: 10000000 ; inline
|
||||
: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline
|
||||
|
||||
: MNT_VISFLAGMASK ( -- n )
|
||||
{
|
||||
MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC
|
||||
MNT_NOSUID MNT_NODEV MNT_UNION
|
||||
MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE
|
||||
MNT_LOCAL MNT_QUOTA
|
||||
MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE
|
||||
MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED
|
||||
MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME
|
||||
} flags ; inline
|
||||
|
||||
: MNT_UPDATE HEX: 00010000 ; inline
|
||||
: MNT_RELOAD HEX: 00040000 ; inline
|
||||
: MNT_FORCE HEX: 00080000 ; inline
|
||||
: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline
|
||||
|
||||
: VFS_GENERIC 0 ; inline
|
||||
: VFS_NUMMNTOPS 1 ; inline
|
||||
: VFS_MAXTYPENUM 1 ; inline
|
||||
: VFS_CONF 2 ; inline
|
||||
: VFS_SET_PACKAGE_EXTS 3 ; inline
|
||||
|
||||
: MNT_WAIT 1 ; inline
|
||||
: MNT_NOWAIT 2 ; inline
|
||||
|
||||
: VFS_CTL_VERS1 HEX: 01 ; inline
|
||||
|
||||
: VFS_CTL_STATFS HEX: 00010001 ; inline
|
||||
: VFS_CTL_UMOUNT HEX: 00010002 ; inline
|
||||
: VFS_CTL_QUERY HEX: 00010003 ; inline
|
||||
: VFS_CTL_NEWADDR HEX: 00010004 ; inline
|
||||
: VFS_CTL_TIMEO HEX: 00010005 ; inline
|
||||
: VFS_CTL_NOLOCKS HEX: 00010006 ; inline
|
||||
|
||||
C-STRUCT: vfsquery
|
||||
{ "uint32_t" "vq_flags" }
|
||||
{ { "uint32_t" 31 } "vq_spare" } ;
|
||||
|
||||
: VQ_NOTRESP HEX: 0001 ; inline
|
||||
: VQ_NEEDAUTH HEX: 0002 ; inline
|
||||
: VQ_LOWDISK HEX: 0004 ; inline
|
||||
: VQ_MOUNT HEX: 0008 ; inline
|
||||
: VQ_UNMOUNT HEX: 0010 ; inline
|
||||
: VQ_DEAD HEX: 0020 ; inline
|
||||
: VQ_ASSIST HEX: 0040 ; inline
|
||||
: VQ_NOTRESPLOCK HEX: 0080 ; inline
|
||||
: VQ_UPDATE HEX: 0100 ; inline
|
||||
: VQ_FLAG0200 HEX: 0200 ; inline
|
||||
: VQ_FLAG0400 HEX: 0400 ; inline
|
||||
: VQ_FLAG0800 HEX: 0800 ; inline
|
||||
: VQ_FLAG1000 HEX: 1000 ; inline
|
||||
: VQ_FLAG2000 HEX: 2000 ; inline
|
||||
: VQ_FLAG4000 HEX: 4000 ; inline
|
||||
: VQ_FLAG8000 HEX: 8000 ; inline
|
||||
|
||||
: NFSV4_MAX_FH_SIZE 128 ; inline
|
||||
: NFSV3_MAX_FH_SIZE 64 ; inline
|
||||
: NFSV2_MAX_FH_SIZE 32 ; inline
|
||||
: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline
|
||||
|
||||
: MFSNAMELEN 15 ; inline
|
||||
: MNAMELEN 90 ; inline
|
||||
: MFSTYPENAMELEN 16 ; inline
|
||||
|
||||
C-STRUCT: fsid_t
|
||||
{ { "int32_t" 2 } "val" } ;
|
||||
|
||||
C-STRUCT: statfs64
|
||||
{ "uint32_t" "f_bsize" }
|
||||
{ "int32_t" "f_iosize" }
|
||||
{ "uint64_t" "f_blocks" }
|
||||
{ "uint64_t" "f_bfree" }
|
||||
{ "uint64_t" "f_bavail" }
|
||||
{ "uint64_t" "f_files" }
|
||||
{ "uint64_t" "f_ffree" }
|
||||
{ "fsid_t" "f_fsid" }
|
||||
{ "uid_t" "f_owner" }
|
||||
{ "uint32_t" "f_type" }
|
||||
{ "uint32_t" "f_flags" }
|
||||
{ "uint32_t" "f_fssubtype" }
|
||||
{ { "char" MFSTYPENAMELEN } "f_fstypename" }
|
||||
{ { "char" MAXPATHLEN } "f_mntonname" }
|
||||
{ { "char" MAXPATHLEN } "f_mntfromname" }
|
||||
{ { "uint32_t" 8 } "f_reserved" } ;
|
||||
|
||||
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
|
||||
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;
|
||||
|
|
|
@ -27,11 +27,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ;
|
|||
} case >>
|
||||
|
||||
: file-status ( pathname -- stat )
|
||||
"stat" <c-object> [
|
||||
[ stat ] unix-system-call drop
|
||||
] keep ;
|
||||
"stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
|
||||
|
||||
: link-status ( pathname -- stat )
|
||||
"stat" <c-object> [
|
||||
[ lstat ] unix-system-call drop
|
||||
] keep ;
|
||||
"stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test unix.statfs.linux ;
|
||||
IN: unix.statfs.linux.tests
|
|
@ -0,0 +1,34 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types combinators kernel io.files unix.stat
|
||||
math accessors system unix io.backend ;
|
||||
IN: unix.statfs.linux
|
||||
|
||||
TUPLE: linux-file-system-info < file-system-info
|
||||
type bsize blocks bfree bavail files ffree fsid
|
||||
namelen frsize spare ;
|
||||
|
||||
: statfs>file-system-info ( struct -- statfs )
|
||||
[ \ linux-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statfs64-f_bsize ]
|
||||
[ statfs64-f_bavail ] bi * >>free-space
|
||||
]
|
||||
[ statfs64-f_type >>type ]
|
||||
[ statfs64-f_bsize >>bsize ]
|
||||
[ statfs64-f_blocks >>blocks ]
|
||||
[ statfs64-f_bfree >>bfree ]
|
||||
[ statfs64-f_bavail >>bavail ]
|
||||
[ statfs64-f_files >>files ]
|
||||
[ statfs64-f_ffree >>ffree ]
|
||||
[ statfs64-f_fsid >>fsid ]
|
||||
[ statfs64-f_namelen >>namelen ]
|
||||
[ statfs64-f_frsize >>frsize ]
|
||||
[ statfs64-f_spare >>spare ]
|
||||
} cleave ;
|
||||
|
||||
M: linux file-system-info ( path -- byte-array )
|
||||
normalize-path
|
||||
"statfs64" <c-object> tuck statfs64 io-error
|
||||
statfs>file-system-info ;
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test unix.statfs.macosx ;
|
||||
IN: unix.statfs.macosx.tests
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types io.encodings.utf8 io.encodings.string
|
||||
kernel sequences unix.stat accessors unix combinators math
|
||||
grouping system unix.statfs io.files io.backend alien.strings ;
|
||||
IN: unix.statfs.macosx
|
||||
|
||||
TUPLE: macosx-file-system-info < file-system-info
|
||||
block-size io-size blocks blocks-free blocks-available files
|
||||
files-free file-system-id owner type flags filesystem-subtype
|
||||
file-system-type-name mount-from ;
|
||||
|
||||
M: macosx mounted* ( -- array )
|
||||
f <void*> dup 0 getmntinfo64 dup io-error
|
||||
[ *void* ] dip
|
||||
"statfs64" heap-size [ * memory>byte-array ] keep group ;
|
||||
|
||||
: statfs64>file-system-info ( byte-array -- file-system-info )
|
||||
[ \ macosx-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
|
||||
>>free-space
|
||||
]
|
||||
[ statfs64-f_mntonname utf8 alien>string >>mount-on ]
|
||||
[ statfs64-f_bsize >>block-size ]
|
||||
|
||||
[ statfs64-f_iosize >>io-size ]
|
||||
[ statfs64-f_blocks >>blocks ]
|
||||
[ statfs64-f_bfree >>blocks-free ]
|
||||
[ statfs64-f_bavail >>blocks-available ]
|
||||
[ statfs64-f_files >>files ]
|
||||
[ statfs64-f_ffree >>files-free ]
|
||||
[ statfs64-f_fsid >>file-system-id ]
|
||||
[ statfs64-f_owner >>owner ]
|
||||
[ statfs64-f_type >>type ]
|
||||
[ statfs64-f_flags >>flags ]
|
||||
[ statfs64-f_fssubtype >>filesystem-subtype ]
|
||||
[
|
||||
statfs64-f_fstypename utf8 alien>string
|
||||
>>file-system-type-name
|
||||
]
|
||||
[
|
||||
statfs64-f_mntfromname
|
||||
utf8 alien>string >>mount-from
|
||||
]
|
||||
} cleave ;
|
||||
|
||||
M: macosx file-system-info ( path -- file-system-info )
|
||||
normalize-path
|
||||
"statfs64" <c-object> tuck statfs64 io-error
|
||||
statfs64>file-system-info ;
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test unix.statfs ;
|
||||
IN: unix.statfs.tests
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: sequences system vocabs.loader combinators accessors
|
||||
kernel math.order sorting ;
|
||||
IN: unix.statfs
|
||||
|
||||
TUPLE: mounted block-size io-size blocks blocks-free
|
||||
blocks-available files files-free file-system-id owner type
|
||||
flags filesystem-subtype file-system-type-name mount-on
|
||||
mount-from ;
|
||||
|
||||
HOOK: mounted* os ( -- array )
|
||||
HOOK: mounted-struct>mounted os ( byte-array -- mounted )
|
||||
|
||||
TUPLE: file-system-info root-directory total-free-size total-size ;
|
||||
|
||||
: mounted ( -- array )
|
||||
mounted* [ mounted-struct>mounted ] map ;
|
||||
|
||||
: mounted-drive ( path -- mounted/f )
|
||||
mounted
|
||||
[ [ mount-on>> ] bi@ <=> ] sort <reversed>
|
||||
[ mount-on>> head? ] with find nip ;
|
||||
|
||||
os {
|
||||
{ linux [ "unix.statfs.linux" require ] }
|
||||
{ macosx [ "unix.statfs.macosx" require ] }
|
||||
! { freebsd [ "unix.statfs.freebsd" require ] }
|
||||
! { netbsd [ "unix.statfs.netbsd" require ] }
|
||||
! { openbsd [ "unix.statfs.openbsd" require ] }
|
||||
} case
|
|
@ -0,0 +1 @@
|
|||
unportable
|
|
@ -1,10 +1,6 @@
|
|||
|
||||
USING: alien.syntax ;
|
||||
|
||||
IN: unix.types
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TYPEDEF: ulonglong __uquad_type
|
||||
TYPEDEF: ulong __ulongword_type
|
||||
TYPEDEF: long __sword_type
|
||||
|
@ -13,17 +9,17 @@ TYPEDEF: long __slongword_type
|
|||
TYPEDEF: uint __u32_type
|
||||
TYPEDEF: int __s32_type
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TYPEDEF: __uquad_type dev_t
|
||||
TYPEDEF: __ulongword_type ino_t
|
||||
TYPEDEF: ino_t __ino_t
|
||||
TYPEDEF: __u32_type mode_t
|
||||
TYPEDEF: __uword_type nlink_t
|
||||
TYPEDEF: __u32_type uid_t
|
||||
TYPEDEF: __u32_type gid_t
|
||||
TYPEDEF: __slongword_type off_t
|
||||
TYPEDEF: off_t __off_t
|
||||
TYPEDEF: __slongword_type blksize_t
|
||||
TYPEDEF: __slongword_type blkcnt_t
|
||||
TYPEDEF: __sword_type ssize_t
|
||||
TYPEDEF: __s32_type pid_t
|
||||
TYPEDEF: __slongword_type time_t
|
||||
TYPEDEF: __slongword_type time_t
|
||||
|
|
|
@ -3,19 +3,6 @@ IN: unix.types
|
|||
|
||||
! NetBSD 4.0
|
||||
|
||||
TYPEDEF: short __int16_t
|
||||
TYPEDEF: ushort __uint16_t
|
||||
TYPEDEF: int __int32_t
|
||||
TYPEDEF: uint __uint32_t
|
||||
TYPEDEF: longlong __int64_t
|
||||
TYPEDEF: longlong __uint64_t
|
||||
|
||||
TYPEDEF: int int32_t
|
||||
TYPEDEF: uint uint32_t
|
||||
TYPEDEF: uint u_int32_t
|
||||
TYPEDEF: longlong int64_t
|
||||
TYPEDEF: ulonglong u_int64_t
|
||||
|
||||
TYPEDEF: __uint32_t __dev_t
|
||||
TYPEDEF: __uint32_t dev_t
|
||||
TYPEDEF: __uint32_t mode_t
|
||||
|
|
|
@ -3,19 +3,6 @@ IN: unix.types
|
|||
|
||||
! OpenBSD 4.2
|
||||
|
||||
TYPEDEF: short __int16_t
|
||||
TYPEDEF: ushort __uint16_t
|
||||
TYPEDEF: int __int32_t
|
||||
TYPEDEF: uint __uint32_t
|
||||
TYPEDEF: longlong __int64_t
|
||||
TYPEDEF: longlong __uint64_t
|
||||
|
||||
TYPEDEF: int int32_t
|
||||
TYPEDEF: uint u_int32_t
|
||||
TYPEDEF: uint uint32_t
|
||||
TYPEDEF: longlong int64_t
|
||||
TYPEDEF: ulonglong u_int64_t
|
||||
|
||||
TYPEDEF: __uint32_t __dev_t
|
||||
TYPEDEF: __uint32_t dev_t
|
||||
TYPEDEF: __uint32_t ino_t
|
||||
|
|
|
@ -16,6 +16,11 @@ TYPEDEF: ushort uint16_t
|
|||
TYPEDEF: uint uint32_t
|
||||
TYPEDEF: ulonglong uint64_t
|
||||
|
||||
TYPEDEF: uchar u_int8_t
|
||||
TYPEDEF: ushort u_int16_t
|
||||
TYPEDEF: uint u_int32_t
|
||||
TYPEDEF: ulonglong u_int64_t
|
||||
|
||||
TYPEDEF: char __int8_t
|
||||
TYPEDEF: short __int16_t
|
||||
TYPEDEF: int __int32_t
|
||||
|
|
|
@ -81,6 +81,7 @@ FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
|
|||
FUNCTION: int chroot ( char* path ) ;
|
||||
|
||||
FUNCTION: int close ( int fd ) ;
|
||||
FUNCTION: int closedir ( DIR* dirp ) ;
|
||||
|
||||
: close-file ( fd -- ) [ close ] unix-system-call drop ;
|
||||
|
||||
|
@ -136,6 +137,8 @@ FUNCTION: int shutdown ( int fd, int how ) ;
|
|||
|
||||
FUNCTION: int open ( char* path, int flags, int prot ) ;
|
||||
|
||||
FUNCTION: DIR* opendir ( char* path ) ;
|
||||
|
||||
: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
|
||||
|
||||
C-STRUCT: utimbuf
|
||||
|
@ -157,6 +160,8 @@ FUNCTION: int pipe ( int* filedes ) ;
|
|||
FUNCTION: void* popen ( char* command, char* type ) ;
|
||||
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
|
||||
|
||||
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
|
||||
|
||||
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
|
||||
|
||||
: PATH_MAX 1024 ; inline
|
||||
|
|
|
@ -2,9 +2,9 @@ USING: kernel ;
|
|||
IN: windows.errors
|
||||
|
||||
: ERROR_SUCCESS 0 ; inline
|
||||
: ERROR_NO_MORE_FILES 18 ; inline
|
||||
: ERROR_HANDLE_EOF 38 ; inline
|
||||
: ERROR_BROKEN_PIPE 109 ; inline
|
||||
: ERROR_ENVVAR_NOT_FOUND 203 ; inline
|
||||
: ERROR_IO_INCOMPLETE 996 ; inline
|
||||
: ERROR_IO_PENDING 997 ; inline
|
||||
|
||||
|
|
|
@ -434,7 +434,6 @@ tuple
|
|||
{ "getenv" "kernel.private" }
|
||||
{ "setenv" "kernel.private" }
|
||||
{ "(exists?)" "io.files.private" }
|
||||
{ "(directory)" "io.files.private" }
|
||||
{ "gc" "memory" }
|
||||
{ "gc-stats" "memory" }
|
||||
{ "save-image" "memory" }
|
||||
|
|
|
@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
|
|||
"Home directory:"
|
||||
{ $subsection home }
|
||||
"Directory listing:"
|
||||
{ $subsection directory }
|
||||
{ $subsection directory* }
|
||||
{ $subsection directory-entries }
|
||||
{ $subsection directory-files }
|
||||
{ $subsection with-directory-files }
|
||||
"Creating directories:"
|
||||
{ $subsection make-directory }
|
||||
{ $subsection make-directories }
|
||||
|
@ -304,23 +305,22 @@ HELP: directory?
|
|||
{ $values { "file-info" file-info } { "?" "a boolean" } }
|
||||
{ $description "Tests if " { $snippet "file-info" } " is a directory." } ;
|
||||
|
||||
HELP: (directory)
|
||||
HELP: (directory-entries)
|
||||
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
|
||||
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
|
||||
{ $notes "This is a low-level word, and user code should call " { $link directory } " instead." } ;
|
||||
{ $notes "This is a low-level word, and user code should call one of the related words instead." } ;
|
||||
|
||||
HELP: directory
|
||||
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
|
||||
HELP: directory-entries
|
||||
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } }
|
||||
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
|
||||
|
||||
HELP: directory*
|
||||
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
|
||||
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
|
||||
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
|
||||
HELP: directory-files
|
||||
{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
|
||||
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
|
||||
|
||||
! HELP: file-modified
|
||||
! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
|
||||
! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
|
||||
HELP: with-directory-files
|
||||
{ $values { "path" "a pathname string" } { "quot" quotation } }
|
||||
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
|
||||
|
||||
HELP: resource-path
|
||||
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
|
||||
|
@ -329,10 +329,6 @@ HELP: resource-path
|
|||
HELP: pathname
|
||||
{ $class-description "Class of path name objects. Path name objects can be created by calling " { $link <pathname> } "." } ;
|
||||
|
||||
HELP: normalize-directory
|
||||
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
|
||||
{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
|
||||
|
||||
HELP: normalize-path
|
||||
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
|
||||
{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;
|
||||
|
|
|
@ -151,18 +151,24 @@ USE: debugger.threads
|
|||
"delete-tree-test" temp-file delete-tree
|
||||
] unit-test
|
||||
|
||||
[ { { "kernel" t } } ] [
|
||||
[ { "kernel" } ] [
|
||||
"core" resource-path [
|
||||
"." directory [ first "kernel" = ] filter
|
||||
"." directory-files [ "kernel" = ] filter
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ { { "kernel" t } } ] [
|
||||
[ { "kernel" } ] [
|
||||
"resource:core" [
|
||||
"." directory [ first "kernel" = ] filter
|
||||
"." directory-files [ "kernel" = ] filter
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ { "kernel" } ] [
|
||||
"resource:core" [
|
||||
[ "kernel" = ] filter
|
||||
] with-directory-files
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"copy-tree-test/a/b/c" temp-file make-directories
|
||||
] unit-test
|
||||
|
|
|
@ -153,7 +153,8 @@ PRIVATE>
|
|||
"." last-split1 nip ;
|
||||
|
||||
! File info
|
||||
TUPLE: file-info type size permissions created modified accessed ;
|
||||
TUPLE: file-info type size permissions created modified
|
||||
accessed ;
|
||||
|
||||
HOOK: file-info io-backend ( path -- info )
|
||||
|
||||
|
@ -181,6 +182,12 @@ SYMBOL: +unknown+
|
|||
|
||||
: directory? ( file-info -- ? ) type>> +directory+ = ;
|
||||
|
||||
! File-system
|
||||
|
||||
TUPLE: file-system-info mount-on free-space ;
|
||||
|
||||
HOOK: file-system-info os ( path -- file-system-info )
|
||||
|
||||
<PRIVATE
|
||||
|
||||
HOOK: cd io-backend ( path -- )
|
||||
|
@ -235,19 +242,22 @@ HOOK: make-directory io-backend ( path -- )
|
|||
]
|
||||
} cond drop ;
|
||||
|
||||
! Directory listings
|
||||
: fixup-directory ( path seq -- newseq )
|
||||
[
|
||||
dup string?
|
||||
[ tuck append-path file-info directory? 2array ] [ nip ] if
|
||||
] with map
|
||||
[ first { "." ".." } member? not ] filter ;
|
||||
TUPLE: directory-entry name type ;
|
||||
|
||||
: directory ( path -- seq )
|
||||
normalize-directory dup (directory) fixup-directory ;
|
||||
HOOK: >directory-entry os ( byte-array -- directory-entry )
|
||||
|
||||
: directory* ( path -- seq )
|
||||
dup directory [ first2 >r append-path r> 2array ] with map ;
|
||||
HOOK: (directory-entries) os ( path -- seq )
|
||||
|
||||
: directory-entries ( path -- seq )
|
||||
normalize-path
|
||||
(directory-entries)
|
||||
[ name>> { "." ".." } member? not ] filter ;
|
||||
|
||||
: directory-files ( path -- seq )
|
||||
directory-entries [ name>> ] map ;
|
||||
|
||||
: with-directory-files ( path quot -- )
|
||||
[ "" directory-files ] prepose with-directory ; inline
|
||||
|
||||
! Touching files
|
||||
HOOK: touch-file io-backend ( path -- )
|
||||
|
@ -259,12 +269,10 @@ HOOK: delete-directory io-backend ( path -- )
|
|||
|
||||
: delete-tree ( path -- )
|
||||
dup link-info type>> +directory+ = [
|
||||
dup directory over [
|
||||
[ first delete-tree ] each
|
||||
] with-directory delete-directory
|
||||
] [
|
||||
delete-file
|
||||
] if ;
|
||||
[ [ [ delete-tree ] each ] with-directory-files ]
|
||||
[ delete-directory ]
|
||||
bi
|
||||
] [ delete-file ] if ;
|
||||
|
||||
: to-directory ( from to -- from to' )
|
||||
over file-name append-path ;
|
||||
|
@ -303,9 +311,9 @@ DEFER: copy-tree-into
|
|||
{
|
||||
{ +symbolic-link+ [ copy-link ] }
|
||||
{ +directory+ [
|
||||
>r dup directory r> rot [
|
||||
[ >r first r> copy-tree-into ] curry each
|
||||
] with-directory
|
||||
swap [
|
||||
[ swap copy-tree-into ] with each
|
||||
] with-directory-files
|
||||
] }
|
||||
[ drop copy-file ]
|
||||
} case ;
|
||||
|
|
|
@ -398,7 +398,7 @@ HELP: filter
|
|||
{ $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
|
||||
|
||||
HELP: filter-here
|
||||
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
|
||||
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } }
|
||||
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
|
||||
{ $side-effects "seq" } ;
|
||||
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,34 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax io.streams.string strings ;
|
||||
IN: crypto.passwd-md5
|
||||
|
||||
HELP: authenticate-password
|
||||
{ $values
|
||||
{ "shadow" string } { "password" string }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Encodes the provided password and compares it to the encoded password entry from a shadowed password file." } ;
|
||||
|
||||
HELP: parse-shadow-password
|
||||
{ $values
|
||||
{ "string" string }
|
||||
{ "magic" string } { "salt" string } { "password" string } }
|
||||
{ $description "Splits a shadowed password entry into a magic string, a salt, and an encoded password string." } ;
|
||||
|
||||
HELP: passwd-md5
|
||||
{ $values
|
||||
{ "magic" string } { "salt" string } { "password" string }
|
||||
{ "bytes" "an md5-shadowed password entry" } }
|
||||
{ $description "Encodes the password with the given magic string and salt to an MD5-shadow password entry." } ;
|
||||
|
||||
ARTICLE: "crypto.passwd-md5" "MD5 shadow passwords"
|
||||
"The " { $vocab-link "crypto.passwd-md5" } " vocabulary can encode passwords for use in an MD5 shadow password file." $nl
|
||||
|
||||
"Encoding a password:"
|
||||
{ $subsection passwd-md5 }
|
||||
"Parsing a shadowed password entry:"
|
||||
{ $subsection parse-shadow-password }
|
||||
"Authenticating against a shadowed password:"
|
||||
{ $subsection authenticate-password } ;
|
||||
|
||||
ABOUT: "crypto.passwd-md5"
|
|
@ -0,0 +1,16 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test crypto.passwd-md5 ;
|
||||
IN: crypto.passwd-md5.tests
|
||||
|
||||
|
||||
[ "$1$npUpD5oQ$1.X7uXR2QG0FzPifVeZ2o1" ]
|
||||
[ "$1$" "npUpD5oQ" "factor" passwd-md5 ] unit-test
|
||||
|
||||
[ "$1$Kilak4kR$wlEr5Dv5DcdqPjKjQtt430" ]
|
||||
[
|
||||
"$1$"
|
||||
"Kilak4kR"
|
||||
"longpassword12345678901234567890"
|
||||
passwd-md5
|
||||
] unit-test
|
|
@ -0,0 +1,47 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel base64 checksums.md5 symbols sequences checksums
|
||||
locals prettyprint math math.bitwise grouping io combinators
|
||||
fry make combinators.short-circuit math.functions splitting ;
|
||||
IN: crypto.passwd-md5
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: lookup-table ( n -- nth )
|
||||
"./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" nth ; inline
|
||||
|
||||
: to64 ( v n -- string )
|
||||
[ [ -6 shift ] [ 6 2^ 1- bitand lookup-table ] bi ]
|
||||
replicate nip ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
:: passwd-md5 ( magic salt password -- bytes )
|
||||
[let* | final! [ password magic salt 3append
|
||||
salt password tuck 3append md5 checksum-bytes
|
||||
password length
|
||||
[ 16 / ceiling swap <repetition> concat ] keep
|
||||
head-slice append
|
||||
password [ length ] [ first ] bi
|
||||
'[ [ CHAR: \0 _ ? , ] each-bit ] "" make append
|
||||
md5 checksum-bytes ] |
|
||||
1000 [
|
||||
"" swap
|
||||
{
|
||||
[ 0 bit? password final ? append ]
|
||||
[ 3 mod 0 > [ salt append ] when ]
|
||||
[ 7 mod 0 > [ password append ] when ]
|
||||
[ 0 bit? final password ? append ]
|
||||
} cleave md5 checksum-bytes final!
|
||||
] each
|
||||
|
||||
magic salt "$" 3append
|
||||
{ 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group
|
||||
[ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat
|
||||
11 final nth 2 to64 3append ] ;
|
||||
|
||||
: parse-shadow-password ( string -- magic salt password )
|
||||
"$" split harvest first3 [ "$" tuck 3append ] 2dip ;
|
||||
|
||||
: authenticate-password ( shadow password -- ? )
|
||||
'[ parse-shadow-password drop _ passwd-md5 ] keep = ;
|
|
@ -59,5 +59,5 @@ TUPLE: ftp-response n strings parsed ;
|
|||
3array " " join ;
|
||||
|
||||
: directory-list ( -- seq )
|
||||
"" directory keys
|
||||
"" directory-files
|
||||
[ [ link-info ] keep file-info>string ] map ;
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
USING: assocs html.parser kernel math sequences strings ascii
|
||||
arrays generalizations shuffle unicode.case namespaces make
|
||||
splitting http accessors io combinators http.client urls
|
||||
urls.encoding fry ;
|
||||
urls.encoding fry prettyprint ;
|
||||
IN: html.parser.analyzer
|
||||
|
||||
TUPLE: link attributes clickable ;
|
||||
|
@ -19,35 +19,34 @@ TUPLE: link attributes clickable ;
|
|||
'[ _ [ second @ ] find-from rot drop swap 1+ ]
|
||||
[ f 0 ] 2dip times drop first2 ; inline
|
||||
|
||||
: find-first-name ( str vector -- i/f tag/f )
|
||||
[ >lower ] dip [ name>> = ] with find ; inline
|
||||
: find-first-name ( vector string -- i/f tag/f )
|
||||
>lower '[ name>> _ = ] find ; inline
|
||||
|
||||
: find-matching-close ( str vector -- i/f tag/f )
|
||||
[ >lower ] dip
|
||||
[ [ name>> = ] [ closing?>> ] bi and ] with find ; inline
|
||||
: find-matching-close ( vector string -- i/f tag/f )
|
||||
>lower
|
||||
'[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline
|
||||
|
||||
: find-between* ( i/f tag/f vector -- vector )
|
||||
pick integer? [
|
||||
rot tail-slice
|
||||
>r name>> r>
|
||||
[ find-matching-close drop dup [ 1+ ] when ] keep
|
||||
swap [ head ] [ first ] if*
|
||||
: find-between* ( vector i/f tag/f -- vector )
|
||||
over integer? [
|
||||
[ tail-slice ] [ name>> ] bi*
|
||||
dupd find-matching-close drop dup [ 1+ ] when
|
||||
[ head ] [ first ] if*
|
||||
] [
|
||||
3drop V{ } clone
|
||||
] if ; inline
|
||||
|
||||
: find-between ( i/f tag/f vector -- vector )
|
||||
|
||||
: find-between ( vector i/f tag/f -- vector )
|
||||
find-between* dup length 3 >= [
|
||||
[ rest-slice but-last-slice ] keep like
|
||||
] when ; inline
|
||||
|
||||
: find-between-first ( string vector -- vector' )
|
||||
[ find-first-name ] keep find-between ; inline
|
||||
: find-between-first ( vector string -- vector' )
|
||||
dupd find-first-name find-between ; inline
|
||||
|
||||
: find-between-all ( vector quot -- seq )
|
||||
[ [ [ closing?>> not ] bi and ] curry find-all ] curry
|
||||
[ [ >r first2 r> find-between* ] curry map ] bi ; inline
|
||||
|
||||
dupd
|
||||
'[ _ [ closing?>> not ] bi and ] find-all
|
||||
[ first2 find-between* ] with map ;
|
||||
|
||||
: remove-blank-text ( vector -- vector' )
|
||||
[
|
||||
|
@ -61,27 +60,40 @@ TUPLE: link attributes clickable ;
|
|||
[ [ [ blank? ] trim ] change-text ] when
|
||||
] map ;
|
||||
|
||||
: find-by-id ( id vector -- vector )
|
||||
[ attributes>> "id" swap at = ] with filter ;
|
||||
: find-by-id ( vector id -- vector' )
|
||||
'[ attributes>> "id" at _ = ] find ;
|
||||
|
||||
: find-by-class ( vector id -- vector' )
|
||||
'[ attributes>> "class" at _ = ] find ;
|
||||
|
||||
: find-by-class ( id vector -- vector )
|
||||
[ attributes>> "class" swap at = ] with filter ;
|
||||
: find-by-name ( vector string -- vector )
|
||||
>lower '[ name>> _ = ] find ;
|
||||
|
||||
: find-by-name ( str vector -- vector )
|
||||
[ >lower ] dip [ name>> = ] with filter ;
|
||||
: find-by-id-between ( vector string -- vector' )
|
||||
dupd
|
||||
'[ attributes>> "id" swap at _ = ] find find-between* ;
|
||||
|
||||
: find-by-class-between ( vector string -- vector' )
|
||||
dupd
|
||||
'[ attributes>> "class" swap at _ = ] find find-between* ;
|
||||
|
||||
: find-by-class-id-between ( vector class id -- vector' )
|
||||
'[
|
||||
[ attributes>> "class" swap at _ = ]
|
||||
[ attributes>> "id" swap at _ = ] bi and
|
||||
] dupd find find-between* ;
|
||||
|
||||
: find-by-attribute-key ( key vector -- vector )
|
||||
[ >lower ] dip
|
||||
[ attributes>> at ] with filter
|
||||
sift ;
|
||||
: find-by-attribute-key ( vector key -- vector' )
|
||||
>lower
|
||||
[ attributes>> at _ = ] filter sift ;
|
||||
|
||||
: find-by-attribute-key-value ( value key vector -- vector )
|
||||
[ >lower ] dip
|
||||
: find-by-attribute-key-value ( vector value key -- vector' )
|
||||
>lower
|
||||
[ attributes>> at over = ] with filter nip
|
||||
sift ;
|
||||
|
||||
: find-first-attribute-key-value ( value key vector -- i/f tag/f )
|
||||
[ >lower ] dip
|
||||
: find-first-attribute-key-value ( vector value key -- i/f tag/f )
|
||||
>lower
|
||||
[ attributes>> at over = ] with find rot drop ;
|
||||
|
||||
: tag-link ( tag -- link/f )
|
||||
|
@ -121,9 +133,9 @@ TUPLE: link attributes clickable ;
|
|||
swap [ >r first2 r> find-between* ] curry map
|
||||
[ [ name>> { "form" "input" } member? ] filter ] map ;
|
||||
|
||||
: find-html-objects ( string vector -- vector' )
|
||||
[ find-opening-tags-by-name ] keep
|
||||
[ [ first2 ] dip find-between* ] curry map ;
|
||||
: find-html-objects ( vector string -- vector' )
|
||||
dupd find-opening-tags-by-name
|
||||
[ first2 find-between* ] curry map ;
|
||||
|
||||
: form-action ( vector -- string )
|
||||
[ name>> "form" = ] find nip
|
||||
|
@ -150,3 +162,12 @@ TUPLE: link attributes clickable ;
|
|||
|
||||
: query>assoc* ( str -- hash )
|
||||
"?" split1 nip query>assoc ;
|
||||
|
||||
: html-class? ( tag string -- ? )
|
||||
swap attributes>> "class" swap at = ;
|
||||
|
||||
: html-id? ( tag string -- ? )
|
||||
swap attributes>> "id" swap at = ;
|
||||
|
||||
: opening-tag? ( tag -- ? )
|
||||
closing?>> not ;
|
||||
|
|
|
@ -7,7 +7,7 @@ IN: io.paths
|
|||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
||||
: qualified-directory ( path -- seq )
|
||||
dup directory [ first2 [ append-path ] dip 2array ] with map ;
|
||||
dup directory-files [ append-path ] with map ;
|
||||
|
||||
: push-directory ( path iter -- )
|
||||
[ qualified-directory ] dip [
|
||||
|
@ -21,7 +21,7 @@ TUPLE: directory-iterator path bfs queue ;
|
|||
|
||||
: next-file ( iter -- file/f )
|
||||
dup queue>> deque-empty? [ drop f ] [
|
||||
dup queue>> pop-back first2
|
||||
dup queue>> pop-back dup link-info directory?
|
||||
[ over push-directory next-file ] [ nip ] if
|
||||
] if ;
|
||||
|
||||
|
|
|
@ -39,7 +39,7 @@ METHOD: expand { variable-expr } expr>> os-env ;
|
|||
METHOD: expand { glob-expr }
|
||||
expr>>
|
||||
dup "*" =
|
||||
[ drop current-directory get directory [ first ] map ]
|
||||
[ drop current-directory get directory-files ]
|
||||
[ ]
|
||||
if ;
|
||||
|
||||
|
|
|
@ -374,15 +374,16 @@ M: revision feed-entry-url id>> revision-url ;
|
|||
{ wiki "wiki-common" } >>template ;
|
||||
|
||||
: init-wiki ( -- )
|
||||
"resource:extra/webapps/wiki/initial-content" directory* keys
|
||||
[
|
||||
dup file-name ".txt" ?tail [
|
||||
swap ascii file-contents
|
||||
f <revision>
|
||||
swap >>content
|
||||
swap >>title
|
||||
"slava" >>author
|
||||
now >>date
|
||||
add-revision
|
||||
] [ 2drop ] if
|
||||
] each ;
|
||||
"resource:extra/webapps/wiki/initial-content" [
|
||||
[
|
||||
dup ".txt" ?tail [
|
||||
swap ascii file-contents
|
||||
f <revision>
|
||||
swap >>content
|
||||
swap >>title
|
||||
"slava" >>author
|
||||
now >>date
|
||||
add-revision
|
||||
] [ 2drop ] if
|
||||
] each
|
||||
] with-directory-files ;
|
||||
|
|
|
@ -7,6 +7,3 @@ extern int getosreldate(void);
|
|||
#ifndef KERN_PROC_PATHNAME
|
||||
#define KERN_PROC_PATHNAME 12
|
||||
#endif
|
||||
|
||||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
||||
|
|
|
@ -1,8 +1,5 @@
|
|||
#include <sys/syscall.h>
|
||||
|
||||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
||||
|
||||
int inotify_init(void);
|
||||
int inotify_add_watch(int fd, const char *name, u32 mask);
|
||||
int inotify_rm_watch(int fd, u32 wd);
|
||||
|
|
|
@ -1,8 +1,6 @@
|
|||
#define DLLEXPORT __attribute__((visibility("default")))
|
||||
#define FACTOR_OS_STRING "macosx"
|
||||
#define NULL_DLL "libfactor.dylib"
|
||||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
||||
|
||||
void init_signals(void);
|
||||
void early_init(void);
|
||||
|
|
|
@ -1,2 +0,0 @@
|
|||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
|
@ -1,2 +0,0 @@
|
|||
#define UNKNOWN_TYPE_P(file) 1
|
||||
#define DIRECTORY_P(file) 0
|
38
vm/os-unix.c
38
vm/os-unix.c
|
@ -61,44 +61,6 @@ DEFINE_PRIMITIVE(existsp)
|
|||
box_boolean(stat(unbox_char_string(),&sb) >= 0);
|
||||
}
|
||||
|
||||
/* Allocates memory */
|
||||
CELL parse_dir_entry(struct dirent *file)
|
||||
{
|
||||
CELL name = tag_object(from_char_string(file->d_name));
|
||||
if(UNKNOWN_TYPE_P(file))
|
||||
return name;
|
||||
else
|
||||
{
|
||||
CELL dirp = tag_boolean(DIRECTORY_P(file));
|
||||
return allot_array_2(name,dirp);
|
||||
}
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(read_dir)
|
||||
{
|
||||
DIR* dir = opendir(unbox_char_string());
|
||||
GROWABLE_ARRAY(result);
|
||||
REGISTER_ROOT(result);
|
||||
|
||||
if(dir != NULL)
|
||||
{
|
||||
struct dirent* file;
|
||||
|
||||
while((file = readdir(dir)) != NULL)
|
||||
{
|
||||
CELL pair = parse_dir_entry(file);
|
||||
GROWABLE_ARRAY_ADD(result,pair);
|
||||
}
|
||||
|
||||
closedir(dir);
|
||||
}
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
|
||||
dpush(result);
|
||||
}
|
||||
|
||||
F_SEGMENT *alloc_segment(CELL size)
|
||||
{
|
||||
int pagesize = getpagesize();
|
||||
|
|
|
@ -8,35 +8,6 @@ s64 current_millis(void)
|
|||
- EPOCH_OFFSET) / 10000;
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(os_envs)
|
||||
{
|
||||
GROWABLE_ARRAY(result);
|
||||
REGISTER_ROOT(result);
|
||||
|
||||
TCHAR *env = GetEnvironmentStrings();
|
||||
TCHAR *finger = env;
|
||||
|
||||
for(;;)
|
||||
{
|
||||
TCHAR *scan = finger;
|
||||
while(*scan != '\0')
|
||||
scan++;
|
||||
if(scan == finger)
|
||||
break;
|
||||
|
||||
CELL string = tag_object(from_u16_string(finger));
|
||||
GROWABLE_ARRAY_ADD(result,string);
|
||||
|
||||
finger = scan + 1;
|
||||
}
|
||||
|
||||
FreeEnvironmentStrings(env);
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
dpush(result);
|
||||
}
|
||||
|
||||
long exception_handler(PEXCEPTION_POINTERS pe)
|
||||
{
|
||||
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
|
||||
|
|
|
@ -87,21 +87,6 @@ const F_CHAR *vm_executable_path(void)
|
|||
return safe_strdup(full_path);
|
||||
}
|
||||
|
||||
void find_file_stat(F_CHAR *path)
|
||||
{
|
||||
// FindFirstFile is the only call that can stat c:\pagefile.sys
|
||||
WIN32_FIND_DATA st;
|
||||
HANDLE h;
|
||||
|
||||
if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
|
||||
dpush(F);
|
||||
else
|
||||
{
|
||||
FindClose(h);
|
||||
dpush(T);
|
||||
}
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(existsp)
|
||||
{
|
||||
BY_HANDLE_FILE_INFORMATION bhfi;
|
||||
|
@ -136,34 +121,6 @@ DEFINE_PRIMITIVE(existsp)
|
|||
CloseHandle(h);
|
||||
}
|
||||
|
||||
DEFINE_PRIMITIVE(read_dir)
|
||||
{
|
||||
HANDLE dir;
|
||||
WIN32_FIND_DATA find_data;
|
||||
F_CHAR *path = unbox_u16_string();
|
||||
|
||||
GROWABLE_ARRAY(result);
|
||||
REGISTER_ROOT(result);
|
||||
|
||||
if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
|
||||
{
|
||||
do
|
||||
{
|
||||
CELL name = tag_object(from_u16_string(find_data.cFileName));
|
||||
CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
|
||||
CELL pair = allot_array_2(name,dirp);
|
||||
GROWABLE_ARRAY_ADD(result,pair);
|
||||
}
|
||||
while (FindNextFile(dir, &find_data));
|
||||
FindClose(dir);
|
||||
}
|
||||
|
||||
UNREGISTER_ROOT(result);
|
||||
GROWABLE_ARRAY_TRIM(result);
|
||||
|
||||
dpush(result);
|
||||
}
|
||||
|
||||
F_SEGMENT *alloc_segment(CELL size)
|
||||
{
|
||||
char *mem;
|
||||
|
|
|
@ -55,7 +55,6 @@
|
|||
#endif
|
||||
#elif defined(__OpenBSD__)
|
||||
#define FACTOR_OS_STRING "openbsd"
|
||||
#include "os-openbsd.h"
|
||||
|
||||
#if defined(FACTOR_X86)
|
||||
#include "os-openbsd-x86.32.h"
|
||||
|
@ -102,7 +101,6 @@
|
|||
#error "Unsupported Solaris flavor"
|
||||
#endif
|
||||
|
||||
#include "os-solaris.h"
|
||||
#else
|
||||
#error "Unsupported OS"
|
||||
#endif
|
||||
|
|
|
@ -57,7 +57,6 @@ void *primitives[] = {
|
|||
primitive_getenv,
|
||||
primitive_setenv,
|
||||
primitive_existsp,
|
||||
primitive_read_dir,
|
||||
primitive_gc,
|
||||
primitive_gc_stats,
|
||||
primitive_save_image,
|
||||
|
|
Loading…
Reference in New Issue