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

Merge branch 'master' into new_codegen

db4
Slava Pestov 2008-10-20 01:59:52 -05:00
parent f092622fac a4f1d4f243
commit af6b8c4e97
33 changed files with 316 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
[ <h1> file-name escape-string write </h1> ]
[
<ul>
directory-files
[ <li> file. </li> ] assoc-each
directory-files [ <li> file. </li> ] each
</ul>
] bi
] simple-page ;

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

@ -19,7 +19,8 @@ DEFER: add-child-monitor
: add-child-monitors ( path -- )
#! We yield since this directory scan might take a while.
[
dup [
[ append-path ] with map
[ add-child-monitor ] each yield
] with-directory-files ;

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

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

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

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

@ -212,8 +212,10 @@ M: vocab-link summary vocab-summary ;
] 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 ;

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

@ -83,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 ] }

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

@ -20,16 +20,6 @@ C-STRUCT: dirent
{ "u_int8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: 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
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

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

@ -39,17 +39,6 @@ C-STRUCT: dirent
{ "__uint8_t" "d_namlen" }
{ { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
: 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
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

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

@ -14,21 +14,11 @@ C-STRUCT: addrinfo
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "ino_t" "d_fileno" }
{ "__uint32_t" "d_fileno" }
{ "__uint16_t" "d_reclen" }
{ "__uint16_t" "d_namlen" }
{ "__uint8_t" "d_type" }
{ { "char" 512 } "d_name" } ;
: 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
{ "__uint8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline

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

@ -20,17 +20,6 @@ C-STRUCT: dirent
{ "__uint8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: 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
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

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

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

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

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

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

@ -1,6 +1,12 @@
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 ] }

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

@ -115,12 +115,6 @@ C-STRUCT: vfsquery
: NFSV2_MAX_FH_SIZE 32 ; inline
: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline
! C-STRUCT: fhandle
! { "int" "fh_len" }
! { { "uchar" NFS_MAX_FH_SIZE } "fh_data" } ;
! TYPEDEF: fhandle fhandle_t
: MFSNAMELEN 15 ; inline
: MNAMELEN 90 ; inline
: MFSTYPENAMELEN 16 ; inline

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

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

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

9
core/kernel/kernel-docs.factor
View File

@ -621,6 +621,14 @@ HELP: 2dip
{ $code "[ foo bar ] 2dip" }
} ;
HELP: 3dip
{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } ", " { $snippet "obj2" } " and " { $snippet "obj3" } " hidden on the retain stack." }
{ $notes "The following are equivalent:"
{ $code ">r >r >r foo bar r> r> r>" }
{ $code "[ foo bar ] 3dip" }
} ;
HELP: while
{ $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
{ $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "body" } " is called. After iteration stops, " { $snippet "tail" } " is called." }
@ -815,6 +823,7 @@ ARTICLE: "slip-keep-combinators" "The dip, slip and keep combinators"
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
{ $subsection dip }
{ $subsection 2dip }
{ $subsection 3dip }
"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
{ $subsection slip }
{ $subsection 2slip }

2
core/kernel/kernel.factor
View File

@ -59,6 +59,8 @@ DEFER: if
: 2dip ( obj1 obj2 quot -- obj1 obj2 ) -rot 2slip ; inline
: 3dip ( obj1 obj2 obj3 quot -- obj1 obj2 obj3 ) -roll 3slip ; inline
! Keepers
: keep ( x quot -- x ) over slip ; inline

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