steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-10-20 01:58:24 -05:00
parent f721105993 84a9a49416
commit a4f1d4f243
64 changed files with 672 additions and 317 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/http/server/static/static.factor
View File

@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ;
\ serve-file NOTICE add-input-logging \ serve-file NOTICE add-input-logging
: file. ( name dirp -- ) : file. ( name -- )
[ "/" append ] when dup link-info directory? [ "/" append ] when
dup <a =href a> escape-string write </a> ; dup <a =href a> escape-string write </a> ;
: directory. ( path -- ) : directory. ( path -- )
@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
[ <h1> file-name escape-string write </h1> ] [ <h1> file-name escape-string write </h1> ]
[ [
<ul> <ul>
directory sort-keys directory-files [ <li> file. </li> ] each
[ <li> file. </li> ] assoc-each
</ul> </ul>
] bi ] bi
] simple-page ; ] simple-page ;

7
basis/io/monitors/recursive/recursive.factor
View File

@ -19,11 +19,14 @@ DEFER: add-child-monitor
: add-child-monitors ( path -- ) : add-child-monitors ( path -- )
#! We yield since this directory scan might take a while. #! 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 -- ) : add-child-monitor ( path -- )
notify? [ dup { +add-file+ } monitor tget queue-change ] when 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 ] [ add-child-monitors ]
[ [
[ [

23
basis/io/unix/files/files.factor
View File

@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar
io.encodings.binary accessors sequences strings system io.encodings.binary accessors sequences strings system
io.files.private destructors vocabs.loader calendar.unix io.files.private destructors vocabs.loader calendar.unix
unix.stat alien.c-types arrays unix.users unix.groups unix.stat alien.c-types arrays unix.users unix.groups
environment ; environment fry io.encodings.utf8 alien.strings ;
IN: io.unix.files IN: io.unix.files
M: unix cwd ( -- path ) M: unix cwd ( -- path )
@ -138,6 +138,27 @@ os {
{ linux [ ] } { linux [ ] }
} case } 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 <PRIVATE
: stat-mode ( path -- mode ) : stat-mode ( path -- mode )

36
basis/io/windows/files/files.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.binary io.backend io.files io.buffers 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 windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words symbols system 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 IN: io.windows.files
: open-file ( path access-mode create-mode flags -- handle ) : open-file ( path access-mode create-mode flags -- handle )
@ -113,8 +114,35 @@ M: windows delete-directory ( path -- )
normalize-path normalize-path
RemoveDirectory win32-error=0/f ; RemoveDirectory win32-error=0/f ;
M: windows normalize-directory ( string -- string ) M: windows >directory-entry ( byte-array -- directory-entry )
normalize-path "\\" ?tail drop "\\*" append ; [ 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+ SYMBOLS: +read-only+ +hidden+ +system+
+archive+ +device+ +normal+ +temporary+ +archive+ +device+ +normal+ +temporary+

2
basis/io/windows/files/unique/unique.factor
View File

@ -1,6 +1,6 @@
USING: kernel system io.files.unique.backend USING: kernel system io.files.unique.backend
windows.kernel32 io.windows io.windows.files io.ports windows windows.kernel32 io.windows io.windows.files io.ports windows
destructors ; destructors environment ;
IN: io.windows.files.unique IN: io.windows.files.unique
M: windows (make-unique-file) ( path -- ) M: windows (make-unique-file) ( path -- )

4
basis/io/windows/nt/launcher/launcher-tests.factor
View File

@ -1,7 +1,7 @@
IN: io.windows.launcher.nt.tests USING: io.launcher tools.test calendar accessors environment
USING: io.launcher tools.test calendar accessors
namespaces kernel system arrays io io.files io.encodings.ascii namespaces kernel system arrays io io.files io.encodings.ascii
sequences parser assocs hashtables math continuations eval ; sequences parser assocs hashtables math continuations eval ;
IN: io.windows.launcher.nt.tests
[ ] [ [ ] [
<process> <process>

1
basis/io/windows/nt/launcher/test/env.factor
View File

@ -1,3 +1,4 @@
USE: system USE: system
USE: prettyprint USE: prettyprint
USE: environment
os-envs . os-envs .

2
basis/logging/server/server.factor
View File

@ -83,7 +83,7 @@ SYMBOL: log-files
: (rotate-logs) ( -- ) : (rotate-logs) ( -- )
(close-logs) (close-logs)
log-root directory [ drop rotate-log ] assoc-each ; log-root directory-files [ rotate-log ] each ;
: log-server-loop ( -- ) : log-server-loop ( -- )
receive unclip { receive unclip {

2
basis/stack-checker/known-words/known-words.factor
View File

@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback
\ (exists?) { string } { object } define-primitive \ (exists?) { string } { object } define-primitive
\ (directory) { string } { array } define-primitive
\ gc { } { } define-primitive \ gc { } { } define-primitive
\ gc-stats { } { array } define-primitive \ gc-stats { } { array } define-primitive

11
basis/tools/vocabs/vocabs.factor
View File

@ -14,8 +14,7 @@ IN: tools.vocabs
: vocab-tests-dir ( vocab -- paths ) : vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" append-path vocab-append-path dup [ dup vocab-dir "tests" append-path vocab-append-path dup [
dup exists? [ dup exists? [
dup directory keys dup directory-files [ ".factor" tail? ] filter
[ ".factor" tail? ] filter
[ append-path ] with map [ append-path ] with map
] [ drop f ] if ] [ drop f ] if
] [ drop f ] if ; ] [ drop f ] if ;
@ -208,11 +207,15 @@ M: vocab-link summary vocab-summary ;
dup vocab-authors-path set-vocab-file-contents ; dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs ) : subdirs ( dir -- dirs )
directory [ second ] filter keys natural-sort ; [
[ link-info directory? ] filter
] with-directory-files natural-sort ;
: (all-child-vocabs) ( root name -- vocabs ) : (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 swap [ "." swap 3append ] with map
] unless-empty ; ] unless-empty ;

12
basis/unix/bsd/bsd.factor
View File

@ -3,8 +3,6 @@
USING: alien.syntax combinators system vocabs.loader ; USING: alien.syntax combinators system vocabs.loader ;
IN: unix IN: unix
! FreeBSD
: MAXPATHLEN 1024 ; inline : MAXPATHLEN 1024 ; inline
: O_RDONLY HEX: 0000 ; inline : O_RDONLY HEX: 0000 ; inline
@ -85,6 +83,16 @@ C-STRUCT: passwd
: SEEK_CUR 1 ; inline : SEEK_CUR 1 ; inline
: SEEK_END 2 ; 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 { os {
{ macosx [ "unix.bsd.macosx" require ] } { macosx [ "unix.bsd.macosx" require ] }
{ freebsd [ "unix.bsd.freebsd" require ] } { freebsd [ "unix.bsd.freebsd" require ] }

7
basis/unix/bsd/freebsd/freebsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "void*" "addr" } { "void*" "addr" }
{ "addrinfo*" "next" } ; { "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 : EPERM 1 ; inline
: ENOENT 2 ; inline : ENOENT 2 ; inline
: ESRCH 3 ; inline : ESRCH 3 ; inline

41
basis/unix/bsd/macosx/macosx.factor
View File

@ -13,6 +13,32 @@ C-STRUCT: addrinfo
{ "void*" "addr" } { "void*" "addr" }
{ "addrinfo*" "next" } ; { "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 : EPERM 1 ; inline
: ENOENT 2 ; inline : ENOENT 2 ; inline
: ESRCH 3 ; inline : ESRCH 3 ; inline
@ -117,18 +143,3 @@ C-STRUCT: addrinfo
: ETIME 101 ; inline : ETIME 101 ; inline
: EOPNOTSUPP 102 ; inline : EOPNOTSUPP 102 ; inline
: ENOPOLICY 103 ; 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" } ;

7
basis/unix/bsd/netbsd/netbsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "void*" "addr" } { "void*" "addr" }
{ "addrinfo*" "next" } ; { "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 : EPERM 1 ; inline
: ENOENT 2 ; inline : ENOENT 2 ; inline
: ESRCH 3 ; inline : ESRCH 3 ; inline

7
basis/unix/bsd/openbsd/openbsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "char*" "canonname" } { "char*" "canonname" }
{ "addrinfo*" "next" } ; { "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 : EPERM 1 ; inline
: ENOENT 2 ; inline : ENOENT 2 ; inline
: ESRCH 3 ; inline : ESRCH 3 ; inline

2
basis/unix/linux/fs/fs.factor
View File

@ -1,6 +1,4 @@
USING: alien.syntax ; USING: alien.syntax ;
IN: unix.linux.fs IN: unix.linux.fs
: MS_RDONLY 1 ; ! Mount read-only. : MS_RDONLY 1 ; ! Mount read-only.

7
basis/unix/linux/linux.factor
View File

@ -92,6 +92,13 @@ C-STRUCT: passwd
{ "char*" "pw_dir" } { "char*" "pw_dir" }
{ "char*" "pw_shell" } ; { "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 : EPERM 1 ; inline
: ENOENT 2 ; inline : ENOENT 2 ; inline
: ESRCH 3 ; inline : ESRCH 3 ; inline

13
basis/unix/stat/linux/32/32.factor
View File

@ -1,6 +1,4 @@
USING: kernel alien.syntax math ; USING: kernel alien.syntax math ;
IN: unix.stat IN: unix.stat
! Ubuntu 8.04 32-bit ! 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 ; : stat ( pathname buf -- int ) 3 -rot __xstat ;
: lstat ( pathname buf -- int ) 3 -rot __lxstat ; : 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" } ;

24
basis/unix/stat/linux/64/64.factor
View File

@ -1,6 +1,5 @@
USING: kernel alien.syntax math sequences unix
USING: kernel alien.syntax math ; alien.c-types arrays accessors combinators ;
IN: unix.stat IN: unix.stat
! Ubuntu 7.10 64-bit ! 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 ; : stat ( pathname buf -- int ) 1 -rot __xstat ;
: lstat ( pathname buf -- int ) 1 -rot __lxstat ; : 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 ) ;

15
basis/unix/stat/linux/linux.factor
View File

@ -1,11 +1,14 @@
USING: alien.syntax layouts combinators vocabs.loader ;
USING: layouts combinators vocabs.loader ;
IN: unix.stat IN: unix.stat
C-STRUCT: fsid
{ { "int" 2 } "__val" } ;
TYPEDEF: fsid __fsid_t
TYPEDEF: fsid fsid_t
cell-bits cell-bits
{ {
{ 32 [ "unix.stat.linux.32" require ] } { 32 [ "unix.stat.linux.32" require ] }
{ 64 [ "unix.stat.linux.64" require ] } { 64 [ "unix.stat.linux.64" require ] }
} } case
case

114
basis/unix/stat/macosx/macosx.factor
View File

@ -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 IN: unix.stat
! Mac OS X ppc ! Mac OS X ppc
@ -30,3 +31,114 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
: stat ( path buf -- n ) stat64 ; : stat ( path buf -- n ) stat64 ;
: lstat ( path buf -- n ) lstat64 ; : 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 ) ;

8
basis/unix/stat/stat.factor
View File

@ -27,11 +27,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ;
} case >> } case >>
: file-status ( pathname -- stat ) : file-status ( pathname -- stat )
"stat" <c-object> [ "stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
[ stat ] unix-system-call drop
] keep ;
: link-status ( pathname -- stat ) : link-status ( pathname -- stat )
"stat" <c-object> [ "stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;
[ lstat ] unix-system-call drop
] keep ;

1
basis/unix/statfs/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

1
basis/unix/statfs/linux/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

4
basis/unix/statfs/linux/linux-tests.factor Normal file
View File

@ -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

34
basis/unix/statfs/linux/linux.factor Normal file
View File

@ -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 ;

1
basis/unix/statfs/linux/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

1
basis/unix/statfs/macosx/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

4
basis/unix/statfs/macosx/macosx-tests.factor Normal file
View File

@ -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

52
basis/unix/statfs/macosx/macosx.factor Normal file
View File

@ -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 ;

1
basis/unix/statfs/macosx/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

4
basis/unix/statfs/statfs-tests.factor Normal file
View File

@ -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

31
basis/unix/statfs/statfs.factor Normal file
View File

@ -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

1
basis/unix/statfs/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

8
basis/unix/types/linux/linux.factor
View File

@ -1,10 +1,6 @@
USING: alien.syntax ; USING: alien.syntax ;
IN: unix.types IN: unix.types
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: ulonglong __uquad_type TYPEDEF: ulonglong __uquad_type
TYPEDEF: ulong __ulongword_type TYPEDEF: ulong __ulongword_type
TYPEDEF: long __sword_type TYPEDEF: long __sword_type
@ -13,15 +9,15 @@ TYPEDEF: long __slongword_type
TYPEDEF: uint __u32_type TYPEDEF: uint __u32_type
TYPEDEF: int __s32_type TYPEDEF: int __s32_type
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: __uquad_type dev_t TYPEDEF: __uquad_type dev_t
TYPEDEF: __ulongword_type ino_t TYPEDEF: __ulongword_type ino_t
TYPEDEF: ino_t __ino_t
TYPEDEF: __u32_type mode_t TYPEDEF: __u32_type mode_t
TYPEDEF: __uword_type nlink_t TYPEDEF: __uword_type nlink_t
TYPEDEF: __u32_type uid_t TYPEDEF: __u32_type uid_t
TYPEDEF: __u32_type gid_t TYPEDEF: __u32_type gid_t
TYPEDEF: __slongword_type off_t TYPEDEF: __slongword_type off_t
TYPEDEF: off_t __off_t
TYPEDEF: __slongword_type blksize_t TYPEDEF: __slongword_type blksize_t
TYPEDEF: __slongword_type blkcnt_t TYPEDEF: __slongword_type blkcnt_t
TYPEDEF: __sword_type ssize_t TYPEDEF: __sword_type ssize_t

13
basis/unix/types/netbsd/netbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! NetBSD 4.0 ! 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 dev_t TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t mode_t TYPEDEF: __uint32_t mode_t

13
basis/unix/types/openbsd/openbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! OpenBSD 4.2 ! 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 dev_t TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t ino_t TYPEDEF: __uint32_t ino_t

5
basis/unix/types/types.factor
View File

@ -16,6 +16,11 @@ TYPEDEF: ushort uint16_t
TYPEDEF: uint uint32_t TYPEDEF: uint uint32_t
TYPEDEF: ulonglong uint64_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: char __int8_t
TYPEDEF: short __int16_t TYPEDEF: short __int16_t
TYPEDEF: int __int32_t TYPEDEF: int __int32_t

5
basis/unix/unix.factor
View File

@ -81,6 +81,7 @@ FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int chroot ( char* path ) ; FUNCTION: int chroot ( char* path ) ;
FUNCTION: int close ( int fd ) ; FUNCTION: int close ( int fd ) ;
FUNCTION: int closedir ( DIR* dirp ) ;
: close-file ( fd -- ) [ close ] unix-system-call drop ; : 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: int open ( char* path, int flags, int prot ) ;
FUNCTION: DIR* opendir ( char* path ) ;
: open-file ( path flags mode -- fd ) [ open ] unix-system-call ; : open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
C-STRUCT: utimbuf C-STRUCT: utimbuf
@ -157,6 +160,8 @@ FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: void* popen ( char* command, char* type ) ; FUNCTION: void* popen ( char* command, char* type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ; 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 ) ; FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
: PATH_MAX 1024 ; inline : PATH_MAX 1024 ; inline

2
basis/windows/errors/errors.factor
View File

@ -2,9 +2,9 @@ USING: kernel ;
IN: windows.errors IN: windows.errors
: ERROR_SUCCESS 0 ; inline : ERROR_SUCCESS 0 ; inline
: ERROR_NO_MORE_FILES 18 ; inline
: ERROR_HANDLE_EOF 38 ; inline : ERROR_HANDLE_EOF 38 ; inline
: ERROR_BROKEN_PIPE 109 ; inline : ERROR_BROKEN_PIPE 109 ; inline
: ERROR_ENVVAR_NOT_FOUND 203 ; inline : ERROR_ENVVAR_NOT_FOUND 203 ; inline
: ERROR_IO_INCOMPLETE 996 ; inline : ERROR_IO_INCOMPLETE 996 ; inline
: ERROR_IO_PENDING 997 ; inline : ERROR_IO_PENDING 997 ; inline

1
core/bootstrap/primitives.factor
View File

@ -434,7 +434,6 @@ tuple
{ "getenv" "kernel.private" } { "getenv" "kernel.private" }
{ "setenv" "kernel.private" } { "setenv" "kernel.private" }
{ "(exists?)" "io.files.private" } { "(exists?)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "gc" "memory" } { "gc" "memory" }
{ "gc-stats" "memory" } { "gc-stats" "memory" }
{ "save-image" "memory" } { "save-image" "memory" }

30
core/io/files/files-docs.factor
View File

@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
"Home directory:" "Home directory:"
{ $subsection home } { $subsection home }
"Directory listing:" "Directory listing:"
{ $subsection directory } { $subsection directory-entries }
{ $subsection directory* } { $subsection directory-files }
{ $subsection with-directory-files }
"Creating directories:" "Creating directories:"
{ $subsection make-directory } { $subsection make-directory }
{ $subsection make-directories } { $subsection make-directories }
@ -304,23 +305,22 @@ HELP: directory?
{ $values { "file-info" file-info } { "?" "a boolean" } } { $values { "file-info" file-info } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "file-info" } " is a directory." } ; { $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" } } { $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } { $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 HELP: directory-entries
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } } { $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ; { $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
HELP: directory* HELP: directory-files
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } } { $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } { $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: file-modified HELP: with-directory-files
! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } } { $values { "path" "a pathname string" } { "quot" quotation } }
! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ; { $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 HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } } { $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
@ -329,10 +329,6 @@ HELP: resource-path
HELP: pathname HELP: pathname
{ $class-description "Class of path name objects. Path name objects can be created by calling " { $link <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 HELP: normalize-path
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } { $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." } ; { $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

14
core/io/files/files-tests.factor
View File

@ -151,18 +151,24 @@ USE: debugger.threads
"delete-tree-test" temp-file delete-tree "delete-tree-test" temp-file delete-tree
] unit-test ] unit-test
[ { { "kernel" t } } ] [ [ { "kernel" } ] [
"core" resource-path [ "core" resource-path [
"." directory [ first "kernel" = ] filter "." directory-files [ "kernel" = ] filter
] with-directory ] with-directory
] unit-test ] unit-test
[ { { "kernel" t } } ] [ [ { "kernel" } ] [
"resource:core" [ "resource:core" [
"." directory [ first "kernel" = ] filter "." directory-files [ "kernel" = ] filter
] with-directory ] with-directory
] unit-test ] unit-test
[ { "kernel" } ] [
"resource:core" [
[ "kernel" = ] filter
] with-directory-files
] unit-test
[ ] [ [ ] [
"copy-tree-test/a/b/c" temp-file make-directories "copy-tree-test/a/b/c" temp-file make-directories
] unit-test ] unit-test

50
core/io/files/files.factor
View File

@ -153,7 +153,8 @@ PRIVATE>
"." last-split1 nip ; "." last-split1 nip ;
! File info ! 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 ) HOOK: file-info io-backend ( path -- info )
@ -181,6 +182,12 @@ SYMBOL: +unknown+
: directory? ( file-info -- ? ) type>> +directory+ = ; : 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 <PRIVATE
HOOK: cd io-backend ( path -- ) HOOK: cd io-backend ( path -- )
@ -235,19 +242,22 @@ HOOK: make-directory io-backend ( path -- )
] ]
} cond drop ; } cond drop ;
! Directory listings TUPLE: directory-entry name type ;
: fixup-directory ( path seq -- newseq )
[
dup string?
[ tuck append-path file-info directory? 2array ] [ nip ] if
] with map
[ first { "." ".." } member? not ] filter ;
: directory ( path -- seq ) HOOK: >directory-entry os ( byte-array -- directory-entry )
normalize-directory dup (directory) fixup-directory ;
: directory* ( path -- seq ) HOOK: (directory-entries) os ( path -- seq )
dup directory [ first2 >r append-path r> 2array ] with map ;
: 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 ! Touching files
HOOK: touch-file io-backend ( path -- ) HOOK: touch-file io-backend ( path -- )
@ -259,12 +269,10 @@ HOOK: delete-directory io-backend ( path -- )
: delete-tree ( path -- ) : delete-tree ( path -- )
dup link-info type>> +directory+ = [ dup link-info type>> +directory+ = [
dup directory over [ [ [ [ delete-tree ] each ] with-directory-files ]
[ first delete-tree ] each [ delete-directory ]
] with-directory delete-directory bi
] [ ] [ delete-file ] if ;
delete-file
] if ;
: to-directory ( from to -- from to' ) : to-directory ( from to -- from to' )
over file-name append-path ; over file-name append-path ;
@ -303,9 +311,9 @@ DEFER: copy-tree-into
{ {
{ +symbolic-link+ [ copy-link ] } { +symbolic-link+ [ copy-link ] }
{ +directory+ [ { +directory+ [
>r dup directory r> rot [ swap [
[ >r first r> copy-tree-into ] curry each [ swap copy-tree-into ] with each
] with-directory ] with-directory-files
] } ] }
[ drop copy-file ] [ drop copy-file ]
} case ; } case ;

2
core/sequences/sequences-docs.factor
View File

@ -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." } ; { $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 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." } { $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
{ $side-effects "seq" } ; { $side-effects "seq" } ;

1
extra/crypto/passwd-md5/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

34
extra/crypto/passwd-md5/passwd-md5-docs.factor Normal file
View File

@ -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"

16
extra/crypto/passwd-md5/passwd-md5-tests.factor Normal file
View File

@ -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

47
extra/crypto/passwd-md5/passwd-md5.factor Normal file
View File

@ -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 = ;

2
extra/ftp/ftp.factor
View File

@ -59,5 +59,5 @@ TUPLE: ftp-response n strings parsed ;
3array " " join ; 3array " " join ;
: directory-list ( -- seq ) : directory-list ( -- seq )
"" directory keys "" directory-files
[ [ link-info ] keep file-info>string ] map ; [ [ link-info ] keep file-info>string ] map ;

91
extra/html/parser/analyzer/analyzer.factor
View File

@ -3,7 +3,7 @@
USING: assocs html.parser kernel math sequences strings ascii USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls splitting http accessors io combinators http.client urls
urls.encoding fry ; urls.encoding fry prettyprint ;
IN: html.parser.analyzer IN: html.parser.analyzer
TUPLE: link attributes clickable ; TUPLE: link attributes clickable ;
@ -19,35 +19,34 @@ TUPLE: link attributes clickable ;
'[ _ [ second @ ] find-from rot drop swap 1+ ] '[ _ [ second @ ] find-from rot drop swap 1+ ]
[ f 0 ] 2dip times drop first2 ; inline [ f 0 ] 2dip times drop first2 ; inline
: find-first-name ( str vector -- i/f tag/f ) : find-first-name ( vector string -- i/f tag/f )
[ >lower ] dip [ name>> = ] with find ; inline >lower '[ name>> _ = ] find ; inline
: find-matching-close ( str vector -- i/f tag/f ) : find-matching-close ( vector string -- i/f tag/f )
[ >lower ] dip >lower
[ [ name>> = ] [ closing?>> ] bi and ] with find ; inline '[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline
: find-between* ( i/f tag/f vector -- vector ) : find-between* ( vector i/f tag/f -- vector )
pick integer? [ over integer? [
rot tail-slice [ tail-slice ] [ name>> ] bi*
>r name>> r> dupd find-matching-close drop dup [ 1+ ] when
[ find-matching-close drop dup [ 1+ ] when ] keep [ head ] [ first ] if*
swap [ head ] [ first ] if*
] [ ] [
3drop V{ } clone 3drop V{ } clone
] if ; inline ] if ; inline
: find-between ( i/f tag/f vector -- vector ) : find-between ( vector i/f tag/f -- vector )
find-between* dup length 3 >= [ find-between* dup length 3 >= [
[ rest-slice but-last-slice ] keep like [ rest-slice but-last-slice ] keep like
] when ; inline ] when ; inline
: find-between-first ( string vector -- vector' ) : find-between-first ( vector string -- vector' )
[ find-first-name ] keep find-between ; inline dupd find-first-name find-between ; inline
: find-between-all ( vector quot -- seq ) : find-between-all ( vector quot -- seq )
[ [ [ closing?>> not ] bi and ] curry find-all ] curry dupd
[ [ >r first2 r> find-between* ] curry map ] bi ; inline '[ _ [ closing?>> not ] bi and ] find-all
[ first2 find-between* ] with map ;
: remove-blank-text ( vector -- vector' ) : remove-blank-text ( vector -- vector' )
[ [
@ -61,27 +60,40 @@ TUPLE: link attributes clickable ;
[ [ [ blank? ] trim ] change-text ] when [ [ [ blank? ] trim ] change-text ] when
] map ; ] map ;
: find-by-id ( id vector -- vector ) : find-by-id ( vector id -- vector' )
[ attributes>> "id" swap at = ] with filter ; '[ attributes>> "id" at _ = ] find ;
: find-by-class ( id vector -- vector ) : find-by-class ( vector id -- vector' )
[ attributes>> "class" swap at = ] with filter ; '[ attributes>> "class" at _ = ] find ;
: find-by-name ( str vector -- vector ) : find-by-name ( vector string -- vector )
[ >lower ] dip [ name>> = ] with filter ; >lower '[ name>> _ = ] find ;
: find-by-attribute-key ( key vector -- vector ) : find-by-id-between ( vector string -- vector' )
[ >lower ] dip dupd
[ attributes>> at ] with filter '[ attributes>> "id" swap at _ = ] find find-between* ;
sift ;
: find-by-attribute-key-value ( value key vector -- vector ) : find-by-class-between ( vector string -- vector' )
[ >lower ] dip 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 ( vector key -- vector' )
>lower
[ attributes>> at _ = ] filter sift ;
: find-by-attribute-key-value ( vector value key -- vector' )
>lower
[ attributes>> at over = ] with filter nip [ attributes>> at over = ] with filter nip
sift ; sift ;
: find-first-attribute-key-value ( value key vector -- i/f tag/f ) : find-first-attribute-key-value ( vector value key -- i/f tag/f )
[ >lower ] dip >lower
[ attributes>> at over = ] with find rot drop ; [ attributes>> at over = ] with find rot drop ;
: tag-link ( tag -- link/f ) : tag-link ( tag -- link/f )
@ -121,9 +133,9 @@ TUPLE: link attributes clickable ;
swap [ >r first2 r> find-between* ] curry map swap [ >r first2 r> find-between* ] curry map
[ [ name>> { "form" "input" } member? ] filter ] map ; [ [ name>> { "form" "input" } member? ] filter ] map ;
: find-html-objects ( string vector -- vector' ) : find-html-objects ( vector string -- vector' )
[ find-opening-tags-by-name ] keep dupd find-opening-tags-by-name
[ [ first2 ] dip find-between* ] curry map ; [ first2 find-between* ] curry map ;
: form-action ( vector -- string ) : form-action ( vector -- string )
[ name>> "form" = ] find nip [ name>> "form" = ] find nip
@ -150,3 +162,12 @@ TUPLE: link attributes clickable ;
: query>assoc* ( str -- hash ) : query>assoc* ( str -- hash )
"?" split1 nip query>assoc ; "?" 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 ;

4
extra/io/paths/paths.factor
View File

@ -7,7 +7,7 @@ IN: io.paths
TUPLE: directory-iterator path bfs queue ; TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq ) : qualified-directory ( path -- seq )
dup directory [ first2 [ append-path ] dip 2array ] with map ; dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- ) : push-directory ( path iter -- )
[ qualified-directory ] dip [ [ qualified-directory ] dip [
@ -21,7 +21,7 @@ TUPLE: directory-iterator path bfs queue ;
: next-file ( iter -- file/f ) : next-file ( iter -- file/f )
dup queue>> deque-empty? [ drop 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 [ over push-directory next-file ] [ nip ] if
] if ; ] if ;

2
extra/shell/shell.factor
View File

@ -39,7 +39,7 @@ METHOD: expand { variable-expr } expr>> os-env ;
METHOD: expand { glob-expr } METHOD: expand { glob-expr }
expr>> expr>>
dup "*" = dup "*" =
[ drop current-directory get directory [ first ] map ] [ drop current-directory get directory-files ]
[ ] [ ]
if ; if ;

7
extra/webapps/wiki/wiki.factor
View File

@ -374,9 +374,9 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "wiki-common" } >>template ; { wiki "wiki-common" } >>template ;
: init-wiki ( -- ) : init-wiki ( -- )
"resource:extra/webapps/wiki/initial-content" directory* keys "resource:extra/webapps/wiki/initial-content" [
[ [
dup file-name ".txt" ?tail [ dup ".txt" ?tail [
swap ascii file-contents swap ascii file-contents
f <revision> f <revision>
swap >>content swap >>content
@ -385,4 +385,5 @@ M: revision feed-entry-url id>> revision-url ;
now >>date now >>date
add-revision add-revision
] [ 2drop ] if ] [ 2drop ] if
] each ; ] each
] with-directory-files ;

3
vm/os-freebsd.h
View File

@ -7,6 +7,3 @@ extern int getosreldate(void);
#ifndef KERN_PROC_PATHNAME #ifndef KERN_PROC_PATHNAME
#define KERN_PROC_PATHNAME 12 #define KERN_PROC_PATHNAME 12
#endif #endif
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

3
vm/os-linux.h
View File

@ -1,8 +1,5 @@
#include <sys/syscall.h> #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_init(void);
int inotify_add_watch(int fd, const char *name, u32 mask); int inotify_add_watch(int fd, const char *name, u32 mask);
int inotify_rm_watch(int fd, u32 wd); int inotify_rm_watch(int fd, u32 wd);

2
vm/os-macosx.h
View File

@ -1,8 +1,6 @@
#define DLLEXPORT __attribute__((visibility("default"))) #define DLLEXPORT __attribute__((visibility("default")))
#define FACTOR_OS_STRING "macosx" #define FACTOR_OS_STRING "macosx"
#define NULL_DLL "libfactor.dylib" #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 init_signals(void);
void early_init(void); void early_init(void);

2
vm/os-openbsd.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

2
vm/os-solaris.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) 1
#define DIRECTORY_P(file) 0

38
vm/os-unix.c
View File

@ -61,44 +61,6 @@ DEFINE_PRIMITIVE(existsp)
box_boolean(stat(unbox_char_string(),&sb) >= 0); 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) F_SEGMENT *alloc_segment(CELL size)
{ {
int pagesize = getpagesize(); int pagesize = getpagesize();

29
vm/os-windows-nt.c
View File

@ -8,35 +8,6 @@ s64 current_millis(void)
- EPOCH_OFFSET) / 10000; - 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) long exception_handler(PEXCEPTION_POINTERS pe)
{ {
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord; PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;

43
vm/os-windows.c
View File

@ -87,21 +87,6 @@ const F_CHAR *vm_executable_path(void)
return safe_strdup(full_path); 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) DEFINE_PRIMITIVE(existsp)
{ {
BY_HANDLE_FILE_INFORMATION bhfi; BY_HANDLE_FILE_INFORMATION bhfi;
@ -136,34 +121,6 @@ DEFINE_PRIMITIVE(existsp)
CloseHandle(h); 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) F_SEGMENT *alloc_segment(CELL size)
{ {
char *mem; char *mem;

2
vm/platform.h
View File

@ -55,7 +55,6 @@
#endif #endif
#elif defined(__OpenBSD__) #elif defined(__OpenBSD__)
#define FACTOR_OS_STRING "openbsd" #define FACTOR_OS_STRING "openbsd"
#include "os-openbsd.h"
#if defined(FACTOR_X86) #if defined(FACTOR_X86)
#include "os-openbsd-x86.32.h" #include "os-openbsd-x86.32.h"
@ -102,7 +101,6 @@
#error "Unsupported Solaris flavor" #error "Unsupported Solaris flavor"
#endif #endif
#include "os-solaris.h"
#else #else
#error "Unsupported OS" #error "Unsupported OS"
#endif #endif

1
vm/primitives.c
View File

@ -57,7 +57,6 @@ void *primitives[] = {
primitive_getenv, primitive_getenv,
primitive_setenv, primitive_setenv,
primitive_existsp, primitive_existsp,
primitive_read_dir,
primitive_gc, primitive_gc,
primitive_gc_stats, primitive_gc_stats,
primitive_save_image, primitive_save_image,