Merge branch 'master' of git://factorcode.org/git/factor
commit
fe16f4d560
|
@ -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 ] }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -20,16 +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
|
||||
: DT_WHT 14 ; inline
|
||||
|
||||
: EPERM 1 ; inline
|
||||
: ENOENT 2 ; inline
|
||||
: ESRCH 3 ; inline
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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,28 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types combinators kernel ;
|
||||
IN: unix.statfs.linux
|
||||
|
||||
TUPLE: linux-file-system-info < file-system-info
|
||||
type bsize blocks bfree bavail files ffree fsid
|
||||
namelen frsize spare ;
|
||||
|
||||
: statfs-struct>statfs ( struct -- statfs )
|
||||
[ \ statfs new ] dip
|
||||
{
|
||||
[ 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 ;
|
||||
|
||||
: statfs ( path -- byte-array )
|
||||
"statfs64" <c-object> [ statfs64 io-error ] keep ;
|
||||
|
|
@ -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
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 = ;
|
Loading…
Reference in New Issue