Merge branch 'master' of git://factorcode.org/git/factor
Eduardo Cavazos
commit
8c3ae91ef3
basis
calendar/unix
cpu/x86/assembler
debugger
http
server/static
io
launcher
monitors/recursive
servers/connection
unix
windows
files
nt
files
launcher
logging/server
stack-checker/known-words
tools
ui
tools
x11
unix
bsd
groups
linux
process
stat
statfs
types
utilities
windows
|
|
@ -4,13 +4,19 @@ USING: alien alien.c-types alien.syntax arrays calendar
|
|||
kernel math unix unix.time namespaces system ;
|
||||
IN: calendar.unix
|
||||
|
||||
: timeval>unix-time ( timeval -- timestamp )
|
||||
: timeval>seconds ( timeval -- seconds )
|
||||
[ timeval-sec seconds ] [ timeval-usec microseconds ] bi
|
||||
time+ since-1970 ;
|
||||
time+ ;
|
||||
|
||||
: timespec>unix-time ( timeval -- timestamp )
|
||||
: timeval>unix-time ( timeval -- timestamp )
|
||||
timeval>seconds since-1970 ;
|
||||
|
||||
: timespec>seconds ( timespec -- seconds )
|
||||
[ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi
|
||||
time+ since-1970 ;
|
||||
time+ ;
|
||||
|
||||
: timespec>unix-time ( timespec -- timestamp )
|
||||
timespec>seconds since-1970 ;
|
||||
|
||||
: get-time ( -- alien )
|
||||
f time <uint> localtime ;
|
||||
|
|
|
|||
|
|
@ -4,9 +4,9 @@ IN: cpu.x86.assembler.tests
|
|||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test
|
||||
|
||||
! [ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
|
||||
! [ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
|
||||
! [ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
|
||||
[ { HEX: 89 HEX: ca } ] [ [ EDX ECX MOV ] { } make ] unit-test
|
||||
[ { HEX: 4c HEX: 89 HEX: e2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
|
||||
[ { HEX: 49 HEX: 89 HEX: d4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: f2 HEX: 0f HEX: 2c HEX: c0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
|
||||
[ { HEX: f2 HEX: 48 HEX: 0f HEX: 2c HEX: c0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
|
||||
|
|
@ -39,3 +39,21 @@ IN: cpu.x86.assembler.tests
|
|||
|
||||
[ { HEX: 80 HEX: 08 HEX: 05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
|
||||
[ { HEX: c6 HEX: 00 HEX: 05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1a } ] [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1b } ] [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 1c } ] [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 48 HEX: 89 HEX: 04 HEX: 1c } ] [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 49 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 48 HEX: 89 HEX: 44 HEX: 1d HEX: 00 } ] [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 4a HEX: 89 HEX: 04 HEX: 23 } ] [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 4a HEX: 89 HEX: 04 HEX: 2b } ] [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 4b HEX: 89 HEX: 44 HEX: 25 HEX: 00 } ] [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test
|
||||
[ { HEX: 4b HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test
|
||||
|
||||
[ { HEX: 49 HEX: 89 HEX: 04 HEX: 2c } ] [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test
|
||||
[ [ R12 RSP [+] RAX MOV ] { } make ] must-fail
|
||||
|
|
|
|||
|
|
@ -64,18 +64,18 @@ M: indirect extended? base>> extended? ;
|
|||
|
||||
: canonicalize-EBP ( indirect -- indirect )
|
||||
#! { EBP } ==> { EBP 0 }
|
||||
dup base>> { EBP RBP R13 } member? [
|
||||
dup displacement>> [ 0 >>displacement ] unless
|
||||
] when ;
|
||||
dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
|
||||
[ 0 >>displacement ] when ;
|
||||
|
||||
: canonicalize-ESP ( indirect -- indirect )
|
||||
#! { ESP } ==> { ESP ESP }
|
||||
dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ;
|
||||
ERROR: bad-index indirect ;
|
||||
|
||||
: check-ESP ( indirect -- indirect )
|
||||
dup index>> { ESP RSP } memq? [ bad-index ] when ;
|
||||
|
||||
: canonicalize ( indirect -- indirect )
|
||||
#! Modify the indirect to work around certain addressing mode
|
||||
#! quirks.
|
||||
canonicalize-EBP canonicalize-ESP ;
|
||||
canonicalize-EBP check-ESP ;
|
||||
|
||||
: <indirect> ( base index scale displacement -- indirect )
|
||||
indirect boa canonicalize ;
|
||||
|
|
@ -91,7 +91,7 @@ M: indirect extended? base>> extended? ;
|
|||
GENERIC: sib-present? ( op -- ? )
|
||||
|
||||
M: indirect sib-present?
|
||||
[ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ;
|
||||
[ base>> { ESP RSP R12 } member? ] [ index>> ] [ scale>> ] tri or or ;
|
||||
|
||||
M: register sib-present? drop f ;
|
||||
|
||||
|
|
@ -254,7 +254,8 @@ M: object operand-64? drop f ;
|
|||
reg-code swap addressing ;
|
||||
|
||||
: direction-bit ( dst src op -- dst' src' op' )
|
||||
pick register? [ BIN: 10 opcode-or swapd ] when ;
|
||||
pick register? pick register? not and
|
||||
[ BIN: 10 opcode-or swapd ] when ;
|
||||
|
||||
: operand-size-bit ( dst src op -- dst' src' op' )
|
||||
over register-8? [ BIN: 1 opcode-or ] unless ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
USING: alien arrays generic generic.math help.markup help.syntax
|
||||
kernel math memory strings sbufs vectors io io.files classes
|
||||
help generic.standard continuations system io.files.private
|
||||
listener ;
|
||||
help generic.standard continuations io.files.private listener ;
|
||||
IN: debugger
|
||||
|
||||
ARTICLE: "debugger" "The debugger"
|
||||
|
|
@ -144,5 +143,4 @@ HELP: memory-error.
|
|||
{ $notes "This can be a result of incorrect usage of C library interface words, a bug in the compiler, or a bug in the VM." } ;
|
||||
|
||||
HELP: primitive-error.
|
||||
{ $error-description "Thrown by the Factor VM if an unsupported primitive word is called." }
|
||||
{ $notes "This word is only ever thrown on Windows CE, where the " { $link cwd } ", " { $link cd } ", and " { $link os-env } " primitives are unsupported." } ;
|
||||
{ $error-description "Thrown by the Factor VM if an unsupported primitive word is called." } ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs help.markup help.syntax io.streams.string sequences strings ;
|
||||
IN: environment
|
||||
|
||||
HELP: (os-envs)
|
||||
{ $values
|
||||
|
||||
{ "seq" sequence } }
|
||||
{ $description "" } ;
|
||||
|
||||
HELP: (set-os-envs)
|
||||
{ $values
|
||||
{ "seq" sequence } }
|
||||
{ $description "" } ;
|
||||
|
||||
|
||||
HELP: os-env ( key -- value )
|
||||
{ $values { "key" string } { "value" string } }
|
||||
{ $description "Looks up the value of a shell environment variable." }
|
||||
{ $examples
|
||||
"This is an operating system-specific feature. On Unix, you can do:"
|
||||
{ $unchecked-example "\"USER\" os-env print" "jane" }
|
||||
} ;
|
||||
|
||||
HELP: os-envs
|
||||
{ $values { "assoc" "an association mapping strings to strings" } }
|
||||
{ $description "Outputs the current set of environment variables." }
|
||||
{ $notes
|
||||
"Names and values of environment variables are operating system-specific."
|
||||
} ;
|
||||
|
||||
HELP: set-os-envs
|
||||
{ $values { "assoc" "an association mapping strings to strings" } }
|
||||
{ $description "Replaces the current set of environment variables." }
|
||||
{ $notes
|
||||
"Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length."
|
||||
} ;
|
||||
|
||||
HELP: set-os-env ( value key -- )
|
||||
{ $values { "value" string } { "key" string } }
|
||||
{ $description "Set an environment variable." }
|
||||
{ $notes
|
||||
"Names and values of environment variables are operating system-specific."
|
||||
} ;
|
||||
|
||||
HELP: unset-os-env ( key -- )
|
||||
{ $values { "key" string } }
|
||||
{ $description "Unset an environment variable." }
|
||||
{ $notes
|
||||
"Names and values of environment variables are operating system-specific."
|
||||
} ;
|
||||
|
||||
{ os-env os-envs set-os-env unset-os-env set-os-envs } related-words
|
||||
|
||||
|
||||
ARTICLE: "environment" "Environment variables"
|
||||
"The " { $vocab-link "environment" } " vocabulary interfaces to the platform-dependent mechanism for setting environment variables." $nl
|
||||
"Windows CE has no concept of environment variables, so these words are undefined on that platform." $nl
|
||||
"Reading environment variables:"
|
||||
{ $subsection os-env }
|
||||
{ $subsection os-envs }
|
||||
"Writing environment variables:"
|
||||
{ $subsection set-os-env }
|
||||
{ $subsection unset-os-env }
|
||||
{ $subsection set-os-envs } ;
|
||||
|
||||
ABOUT: "environment"
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces prettyprint system tools.test
|
||||
environment strings sequences ;
|
||||
IN: environment.tests
|
||||
|
||||
os wince? [
|
||||
[ ] [ os-envs . ] unit-test
|
||||
|
||||
os unix? [
|
||||
[ ] [ os-envs "envs" set ] unit-test
|
||||
[ ] [ { { "A" "B" } } set-os-envs ] unit-test
|
||||
[ "B" ] [ "A" os-env ] unit-test
|
||||
[ ] [ "envs" get set-os-envs ] unit-test
|
||||
[ t ] [ os-envs "envs" get = ] unit-test
|
||||
] when
|
||||
|
||||
[ ] [ "factor-test-key-1" unset-os-env ] unit-test
|
||||
[ ] [ "ps3" "factor-test-key-1" set-os-env ] unit-test
|
||||
[ "ps3" ] [ "factor-test-key-1" os-env ] unit-test
|
||||
[ ] [ "factor-test-key-1" unset-os-env ] unit-test
|
||||
[ f ] [ "factor-test-key-1" os-env ] unit-test
|
||||
|
||||
[ ] [
|
||||
32766 CHAR: a <string> "factor-test-key-long" set-os-env
|
||||
] unit-test
|
||||
[ 32766 ] [ "factor-test-key-long" os-env length ] unit-test
|
||||
[ ] [ "factor-test-key-long" unset-os-env ] unit-test
|
||||
] unless
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs combinators kernel sequences splitting system
|
||||
vocabs.loader ;
|
||||
IN: environment
|
||||
|
||||
HOOK: os-env os ( key -- value )
|
||||
|
||||
HOOK: set-os-env os ( value key -- )
|
||||
|
||||
HOOK: unset-os-env os ( key -- )
|
||||
|
||||
HOOK: (os-envs) os ( -- seq )
|
||||
|
||||
HOOK: (set-os-envs) os ( seq -- )
|
||||
|
||||
: os-envs ( -- assoc )
|
||||
(os-envs) [ "=" split1 ] H{ } map>assoc ;
|
||||
|
||||
: set-os-envs ( assoc -- )
|
||||
[ "=" swap 3append ] { } assoc>map (set-os-envs) ;
|
||||
|
||||
{
|
||||
{ [ os unix? ] [ "environment.unix" require ] }
|
||||
{ [ os winnt? ] [ "environment.winnt" require ] }
|
||||
{ [ os wince? ] [ ] }
|
||||
} cond
|
||||
|
|
@ -0,0 +1 @@
|
|||
Environment variables
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax system environment.unix ;
|
||||
IN: environment.unix.macosx
|
||||
|
||||
FUNCTION: void* _NSGetEnviron ( ) ;
|
||||
|
||||
M: macosx environ _NSGetEnviron ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.strings alien.syntax kernel
|
||||
layouts sequences system unix environment io.encodings.utf8
|
||||
unix.utilities vocabs.loader combinators alien.accessors ;
|
||||
IN: environment.unix
|
||||
|
||||
HOOK: environ os ( -- void* )
|
||||
|
||||
M: unix environ ( -- void* ) "environ" f dlsym ;
|
||||
|
||||
M: unix os-env ( key -- value ) getenv ;
|
||||
|
||||
M: unix set-os-env ( value key -- ) swap 1 setenv io-error ;
|
||||
|
||||
M: unix unset-os-env ( key -- ) unsetenv io-error ;
|
||||
|
||||
M: unix (os-envs) ( -- seq )
|
||||
environ *void* utf8 alien>strings ;
|
||||
|
||||
: set-void* ( value alien -- ) 0 set-alien-cell ;
|
||||
|
||||
M: unix (set-os-envs) ( seq -- )
|
||||
utf8 strings>alien malloc-byte-array environ set-void* ;
|
||||
|
||||
os {
|
||||
{ macosx [ "environment.unix.macosx" require ] }
|
||||
[ drop ]
|
||||
} case
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.strings fry io.encodings.utf16 kernel
|
||||
splitting windows windows.kernel32 system environment
|
||||
alien.c-types sequences windows.errors io.streams.memory
|
||||
io.encodings io ;
|
||||
IN: environment.winnt
|
||||
|
||||
M: winnt os-env ( key -- value )
|
||||
MAX_UNICODE_PATH "TCHAR" <c-array>
|
||||
[ dup length GetEnvironmentVariable ] keep over 0 = [
|
||||
2drop f
|
||||
] [
|
||||
nip utf16n alien>string
|
||||
] if ;
|
||||
|
||||
M: winnt set-os-env ( value key -- )
|
||||
swap SetEnvironmentVariable win32-error=0/f ;
|
||||
|
||||
M: winnt unset-os-env ( key -- )
|
||||
f SetEnvironmentVariable 0 = [
|
||||
GetLastError ERROR_ENVVAR_NOT_FOUND =
|
||||
[ win32-error ] unless
|
||||
] when ;
|
||||
|
||||
M: winnt (os-envs) ( -- seq )
|
||||
GetEnvironmentStrings [
|
||||
<memory-stream> [
|
||||
utf16n decode-input
|
||||
[ "\0" read-until drop dup empty? not ]
|
||||
[ ] [ drop ] produce
|
||||
] with-input-stream*
|
||||
] [ FreeEnvironmentStrings win32-error=0/f ] bi ;
|
||||
|
|
@ -192,110 +192,104 @@ test-db [
|
|||
init-furnace-tables
|
||||
] with-db
|
||||
|
||||
: test-httpd ( -- )
|
||||
#! Return as soon as server is running.
|
||||
<http-server>
|
||||
1237 >>insecure
|
||||
f >>secure
|
||||
start-server* ;
|
||||
: test-httpd ( responder -- )
|
||||
[
|
||||
main-responder set
|
||||
<http-server>
|
||||
0 >>insecure
|
||||
f >>secure
|
||||
dup start-server*
|
||||
sockets>> first addr>> port>>
|
||||
] with-scope "port" set ;
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
add-quit-action
|
||||
<dispatcher>
|
||||
add-quit-action
|
||||
<dispatcher>
|
||||
"resource:basis/http/test" <static> >>default
|
||||
"nested" add-responder
|
||||
<action>
|
||||
[ URL" redirect-loop" <temporary-redirect> ] >>display
|
||||
"redirect-loop" add-responder
|
||||
main-responder set
|
||||
"resource:basis/http/test" <static> >>default
|
||||
"nested" add-responder
|
||||
<action>
|
||||
[ URL" redirect-loop" <temporary-redirect> ] >>display
|
||||
"redirect-loop" add-responder
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
: add-port ( url -- url' )
|
||||
>url clone "port" get >>port ;
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/http/test/foo.html" ascii file-contents
|
||||
"http://localhost:1237/nested/foo.html" http-get nip =
|
||||
"http://localhost/nested/foo.html" add-port http-get nip =
|
||||
] unit-test
|
||||
|
||||
[ "http://localhost:1237/redirect-loop" http-get nip ]
|
||||
[ "http://localhost/redirect-loop" add-port http-get nip ]
|
||||
[ too-many-redirects? ] must-fail-with
|
||||
|
||||
[ "Goodbye" ] [
|
||||
"http://localhost:1237/quit" http-get nip
|
||||
"http://localhost/quit" add-port http-get nip
|
||||
] unit-test
|
||||
|
||||
! HTTP client redirect bug
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
add-quit-action
|
||||
<action> [ "quit" <temporary-redirect> ] >>display
|
||||
"redirect" add-responder
|
||||
main-responder set
|
||||
<dispatcher>
|
||||
add-quit-action
|
||||
<action> [ "quit" <temporary-redirect> ] >>display
|
||||
"redirect" add-responder
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
[ "Goodbye" ] [
|
||||
"http://localhost:1237/redirect" http-get nip
|
||||
"http://localhost/redirect" add-port http-get nip
|
||||
] unit-test
|
||||
|
||||
|
||||
[ ] [
|
||||
[ "http://localhost:1237/quit" http-get 2drop ] ignore-errors
|
||||
[ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
|
||||
] unit-test
|
||||
|
||||
! Dispatcher bugs
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
<action> <protected>
|
||||
"Test" <login-realm>
|
||||
<sessions>
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
<dispatcher>
|
||||
<action> <protected>
|
||||
"Test" <login-realm>
|
||||
<sessions>
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
<dispatcher>
|
||||
<action> "" add-responder
|
||||
"d" add-responder
|
||||
test-db <db-persistence>
|
||||
main-responder set
|
||||
<action> "" add-responder
|
||||
"d" add-responder
|
||||
test-db <db-persistence>
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
: 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ;
|
||||
|
||||
! This should give a 404 not an infinite redirect loop
|
||||
[ "http://localhost:1237/d/blah" http-get nip ] [ 404? ] must-fail-with
|
||||
[ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with
|
||||
|
||||
! This should give a 404 not an infinite redirect loop
|
||||
[ "http://localhost:1237/blah/" http-get nip ] [ 404? ] must-fail-with
|
||||
[ "http://localhost/blah/" add-port http-get nip ] [ 404? ] must-fail-with
|
||||
|
||||
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
|
||||
[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
<action> [ [ "Hi" write ] "text/plain" <content> ] >>display
|
||||
"Test" <login-realm>
|
||||
<sessions>
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
test-db <db-persistence>
|
||||
main-responder set
|
||||
<dispatcher>
|
||||
<action> [ [ "Hi" write ] "text/plain" <content> ] >>display
|
||||
"Test" <login-realm>
|
||||
<sessions>
|
||||
"" add-responder
|
||||
add-quit-action
|
||||
test-db <db-persistence>
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
[ "Hi" ] [ "http://localhost:1237/" http-get nip ] unit-test
|
||||
[ "Hi" ] [ "http://localhost/" add-port http-get nip ] unit-test
|
||||
|
||||
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
|
||||
[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
|
||||
|
||||
USING: html.components html.elements html.forms
|
||||
xml xml.utilities validators
|
||||
|
|
@ -304,22 +298,19 @@ furnace furnace.conversations ;
|
|||
SYMBOL: a
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
<action>
|
||||
[ a get-global "a" set-value ] >>init
|
||||
[ [ <html> "a" <field> render </html> ] "text/html" <content> ] >>display
|
||||
[ { { "a" [ v-integer ] } } validate-params ] >>validate
|
||||
[ "a" value a set-global URL" " <redirect> ] >>submit
|
||||
<conversations>
|
||||
<sessions>
|
||||
>>default
|
||||
add-quit-action
|
||||
test-db <db-persistence>
|
||||
main-responder set
|
||||
<dispatcher>
|
||||
<action>
|
||||
[ a get-global "a" set-value ] >>init
|
||||
[ [ <html> "a" <field> render </html> ] "text/html" <content> ] >>display
|
||||
[ { { "a" [ v-integer ] } } validate-params ] >>validate
|
||||
[ "a" value a set-global URL" " <redirect> ] >>submit
|
||||
<conversations>
|
||||
<sessions>
|
||||
>>default
|
||||
add-quit-action
|
||||
test-db <db-persistence>
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
3 a set-global
|
||||
|
|
@ -327,27 +318,35 @@ SYMBOL: a
|
|||
: test-a string>xml "input" tag-named "value" swap at ;
|
||||
|
||||
[ "3" ] [
|
||||
"http://localhost:1237/" http-get
|
||||
"http://localhost/" add-port http-get
|
||||
swap dup cookies>> "cookies" set session-id-key get-cookie
|
||||
value>> "session-id" set test-a
|
||||
] unit-test
|
||||
|
||||
[ "4" ] [
|
||||
H{ { "a" "4" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
|
||||
"http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
|
||||
[
|
||||
"4" "a" set
|
||||
"http://localhost" add-port "__u" set
|
||||
"session-id" get session-id-key set
|
||||
] H{ } make-assoc
|
||||
"http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
|
||||
] unit-test
|
||||
|
||||
[ 4 ] [ a get-global ] unit-test
|
||||
|
||||
! Test flash scope
|
||||
[ "xyz" ] [
|
||||
H{ { "a" "xyz" } { "__u" "http://localhost:1237/" } } "session-id" get session-id-key associate assoc-union
|
||||
"http://localhost:1237/" <post-request> "cookies" get >>cookies http-request nip test-a
|
||||
[
|
||||
"xyz" "a" set
|
||||
"http://localhost" add-port "__u" set
|
||||
"session-id" get session-id-key set
|
||||
] H{ } make-assoc
|
||||
"http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
|
||||
] unit-test
|
||||
|
||||
[ 4 ] [ a get-global ] unit-test
|
||||
|
||||
[ "Goodbye" ] [ "http://localhost:1237/quit" http-get nip ] unit-test
|
||||
[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
|
||||
|
||||
! Test cloning
|
||||
[ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: system kernel namespaces strings hashtables sequences
|
||||
assocs combinators vocabs.loader init threads continuations
|
||||
math accessors concurrency.flags destructors
|
||||
math accessors concurrency.flags destructors environment
|
||||
io io.backend io.timeouts io.pipes io.pipes.private io.encodings
|
||||
io.streams.duplex io.ports debugger prettyprint summary ;
|
||||
IN: io.launcher
|
||||
|
|
@ -58,8 +58,6 @@ SYMBOL: +realtime-priority+
|
|||
! Non-blocking process exit notification facility
|
||||
SYMBOL: processes
|
||||
|
||||
[ H{ } clone processes set-global ] "io.launcher" add-init-hook
|
||||
|
||||
HOOK: wait-for-processes io-backend ( -- ? )
|
||||
|
||||
SYMBOL: wait-flag
|
||||
|
|
@ -73,7 +71,10 @@ SYMBOL: wait-flag
|
|||
<flag> wait-flag set-global
|
||||
[ wait-loop t ] "Process wait" spawn-server drop ;
|
||||
|
||||
[ start-wait-thread ] "io.launcher" add-init-hook
|
||||
[
|
||||
H{ } clone processes set-global
|
||||
start-wait-thread
|
||||
] "io.launcher" add-init-hook
|
||||
|
||||
: process-started ( process handle -- )
|
||||
>>handle
|
||||
|
|
|
|||
|
|
@ -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 ]
|
||||
[
|
||||
[
|
||||
|
|
|
|||
|
|
@ -27,25 +27,12 @@ concurrency.promises io.encodings.ascii io threads calendar ;
|
|||
init-server semaphore>> count>>
|
||||
] unit-test
|
||||
|
||||
[ ] [ <promise> "p" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
<threaded-server>
|
||||
5 >>max-connections
|
||||
1237 >>insecure
|
||||
0 >>insecure
|
||||
[ "Hello world." write stop-this-server ] >>handler
|
||||
"server" set
|
||||
dup start-server* sockets>> first addr>> port>> "port" set
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"server" get start-server
|
||||
t "p" get fulfill
|
||||
] in-thread
|
||||
] unit-test
|
||||
|
||||
[ ] [ "server" get wait-for-server ] unit-test
|
||||
|
||||
[ "Hello world." ] [ "localhost" 1237 <inet> ascii <client> drop contents ] unit-test
|
||||
|
||||
[ t ] [ "p" get 2 seconds ?promise-timeout ] unit-test
|
||||
[ "Hello world." ] [ "localhost" "port" get <inet> ascii <client> drop contents ] unit-test
|
||||
|
|
|
|||
|
|
@ -13,5 +13,8 @@ M: bsd stat>file-info ( stat -- file-info )
|
|||
{
|
||||
[ stat-st_flags >>flags ]
|
||||
[ stat-st_gen >>gen ]
|
||||
[ stat-st_birthtimespec timespec>unix-time >>birth-time ]
|
||||
[
|
||||
stat-st_birthtimespec timespec>unix-time
|
||||
>>birth-time
|
||||
]
|
||||
} cleave ;
|
||||
|
|
|
|||
|
|
@ -36,39 +36,39 @@ HELP: file-user-id
|
|||
|
||||
HELP: group-execute?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: group-read?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: group-write?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: other-execute?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: other-read?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: other-write?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: set-file-access-time
|
||||
{ $values
|
||||
|
|
@ -124,9 +124,9 @@ HELP: set-gid
|
|||
|
||||
HELP: gid?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: set-group-execute
|
||||
{ $values
|
||||
|
|
@ -165,9 +165,9 @@ HELP: set-sticky
|
|||
|
||||
HELP: sticky?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "sticky" } " bit of a file is set." } ;
|
||||
{ $description "Tests whether the " { $snippet "sticky" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: set-uid
|
||||
{ $values
|
||||
|
|
@ -176,9 +176,9 @@ HELP: set-uid
|
|||
|
||||
HELP: uid?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "uid" } " bit of a file is set." } ;
|
||||
{ $description "Tests whether the " { $snippet "uid" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: set-user-execute
|
||||
{ $values
|
||||
|
|
@ -197,21 +197,21 @@ HELP: set-user-write
|
|||
|
||||
HELP: user-execute?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: user-read?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
HELP: user-write?
|
||||
{ $values
|
||||
{ "path" "a pathname string" }
|
||||
{ "obj" "a pathname string, file-info object, or an integer" }
|
||||
{ "?" "a boolean" } }
|
||||
{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file." } ;
|
||||
{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file, " { $link file-info } ", or an integer." } ;
|
||||
|
||||
ARTICLE: "unix-file-permissions" "Unix file permissions"
|
||||
"Reading all file permissions:"
|
||||
|
|
|
|||
|
|
@ -55,32 +55,32 @@ prepare-test-file
|
|||
[ t ] [ test-file other-write? ] unit-test
|
||||
[ t ] [ test-file other-execute? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-other-execute perms OCT: 776 = ] unit-test
|
||||
[ t ] [ test-file f set-other-execute perms OCT: 776 = ] unit-test
|
||||
[ f ] [ test-file file-info other-execute? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-other-write perms OCT: 774 = ] unit-test
|
||||
[ t ] [ test-file f set-other-write perms OCT: 774 = ] unit-test
|
||||
[ f ] [ test-file file-info other-write? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-other-read perms OCT: 770 = ] unit-test
|
||||
[ t ] [ test-file f set-other-read perms OCT: 770 = ] unit-test
|
||||
[ f ] [ test-file file-info other-read? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-group-execute perms OCT: 760 = ] unit-test
|
||||
[ t ] [ test-file f set-group-execute perms OCT: 760 = ] unit-test
|
||||
[ f ] [ test-file file-info group-execute? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-group-write perms OCT: 740 = ] unit-test
|
||||
[ t ] [ test-file f set-group-write perms OCT: 740 = ] unit-test
|
||||
[ f ] [ test-file file-info group-write? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-group-read perms OCT: 700 = ] unit-test
|
||||
[ t ] [ test-file f set-group-read perms OCT: 700 = ] unit-test
|
||||
[ f ] [ test-file file-info group-read? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-user-execute perms OCT: 600 = ] unit-test
|
||||
[ t ] [ test-file f set-user-execute perms OCT: 600 = ] unit-test
|
||||
[ f ] [ test-file file-info other-execute? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-user-write perms OCT: 400 = ] unit-test
|
||||
[ t ] [ test-file f set-user-write perms OCT: 400 = ] unit-test
|
||||
[ f ] [ test-file file-info other-write? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file f set-user-read perms OCT: 000 = ] unit-test
|
||||
[ t ] [ test-file f set-user-read perms OCT: 000 = ] unit-test
|
||||
[ f ] [ test-file file-info other-read? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test
|
||||
|
|
@ -135,3 +135,29 @@ prepare-test-file
|
|||
|
||||
[ ]
|
||||
[ test-file f f set-file-ids ] unit-test
|
||||
|
||||
[ t ] [ OCT: 4000 uid? ] unit-test
|
||||
[ t ] [ OCT: 2000 gid? ] unit-test
|
||||
[ t ] [ OCT: 1000 sticky? ] unit-test
|
||||
[ t ] [ OCT: 400 user-read? ] unit-test
|
||||
[ t ] [ OCT: 200 user-write? ] unit-test
|
||||
[ t ] [ OCT: 100 user-execute? ] unit-test
|
||||
[ t ] [ OCT: 040 group-read? ] unit-test
|
||||
[ t ] [ OCT: 020 group-write? ] unit-test
|
||||
[ t ] [ OCT: 010 group-execute? ] unit-test
|
||||
[ t ] [ OCT: 004 other-read? ] unit-test
|
||||
[ t ] [ OCT: 002 other-write? ] unit-test
|
||||
[ t ] [ OCT: 001 other-execute? ] unit-test
|
||||
|
||||
[ f ] [ 0 uid? ] unit-test
|
||||
[ f ] [ 0 gid? ] unit-test
|
||||
[ f ] [ 0 sticky? ] unit-test
|
||||
[ f ] [ 0 user-read? ] unit-test
|
||||
[ f ] [ 0 user-write? ] unit-test
|
||||
[ f ] [ 0 user-execute? ] unit-test
|
||||
[ f ] [ 0 group-read? ] unit-test
|
||||
[ f ] [ 0 group-write? ] unit-test
|
||||
[ f ] [ 0 group-execute? ] unit-test
|
||||
[ f ] [ 0 other-read? ] unit-test
|
||||
[ f ] [ 0 other-write? ] unit-test
|
||||
[ f ] [ 0 other-execute? ] unit-test
|
||||
|
|
|
|||
|
|
@ -5,7 +5,8 @@ unix unix.stat unix.time kernel math continuations
|
|||
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 ;
|
||||
unix.stat alien.c-types arrays unix.users unix.groups
|
||||
environment fry io.encodings.utf8 alien.strings unix.statfs ;
|
||||
IN: io.unix.files
|
||||
|
||||
M: unix cwd ( -- path )
|
||||
|
|
@ -137,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 )
|
||||
|
|
@ -166,18 +188,57 @@ PRIVATE>
|
|||
: OTHER-WRITE OCT: 0000002 ; inline
|
||||
: OTHER-EXECUTE OCT: 0000001 ; inline
|
||||
|
||||
: uid? ( path -- ? ) UID file-mode? ;
|
||||
: gid? ( path -- ? ) GID file-mode? ;
|
||||
: sticky? ( path -- ? ) STICKY file-mode? ;
|
||||
: user-read? ( path -- ? ) USER-READ file-mode? ;
|
||||
: user-write? ( path -- ? ) USER-WRITE file-mode? ;
|
||||
: user-execute? ( path -- ? ) USER-EXECUTE file-mode? ;
|
||||
: group-read? ( path -- ? ) GROUP-READ file-mode? ;
|
||||
: group-write? ( path -- ? ) GROUP-WRITE file-mode? ;
|
||||
: group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ;
|
||||
: other-read? ( path -- ? ) OTHER-READ file-mode? ;
|
||||
: other-write? ( path -- ? ) OTHER-WRITE file-mode? ;
|
||||
: other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
|
||||
GENERIC: uid? ( obj -- ? )
|
||||
GENERIC: gid? ( obj -- ? )
|
||||
GENERIC: sticky? ( obj -- ? )
|
||||
GENERIC: user-read? ( obj -- ? )
|
||||
GENERIC: user-write? ( obj -- ? )
|
||||
GENERIC: user-execute? ( obj -- ? )
|
||||
GENERIC: group-read? ( obj -- ? )
|
||||
GENERIC: group-write? ( obj -- ? )
|
||||
GENERIC: group-execute? ( obj -- ? )
|
||||
GENERIC: other-read? ( obj -- ? )
|
||||
GENERIC: other-write? ( obj -- ? )
|
||||
GENERIC: other-execute? ( obj -- ? )
|
||||
|
||||
M: integer uid? ( integer -- ? ) UID mask? ;
|
||||
M: integer gid? ( integer -- ? ) GID mask? ;
|
||||
M: integer sticky? ( integer -- ? ) STICKY mask? ;
|
||||
M: integer user-read? ( integer -- ? ) USER-READ mask? ;
|
||||
M: integer user-write? ( integer -- ? ) USER-WRITE mask? ;
|
||||
M: integer user-execute? ( integer -- ? ) USER-EXECUTE mask? ;
|
||||
M: integer group-read? ( integer -- ? ) GROUP-READ mask? ;
|
||||
M: integer group-write? ( integer -- ? ) GROUP-WRITE mask? ;
|
||||
M: integer group-execute? ( integer -- ? ) GROUP-EXECUTE mask? ;
|
||||
M: integer other-read? ( integer -- ? ) OTHER-READ mask? ;
|
||||
M: integer other-write? ( integer -- ? ) OTHER-WRITE mask? ;
|
||||
M: integer other-execute? ( integer -- ? ) OTHER-EXECUTE mask? ;
|
||||
|
||||
M: file-info uid? ( file-info -- ? ) permissions>> uid? ;
|
||||
M: file-info gid? ( file-info -- ? ) permissions>> gid? ;
|
||||
M: file-info sticky? ( file-info -- ? ) permissions>> sticky? ;
|
||||
M: file-info user-read? ( file-info -- ? ) permissions>> user-read? ;
|
||||
M: file-info user-write? ( file-info -- ? ) permissions>> user-write? ;
|
||||
M: file-info user-execute? ( file-info -- ? ) permissions>> user-execute? ;
|
||||
M: file-info group-read? ( file-info -- ? ) permissions>> group-read? ;
|
||||
M: file-info group-write? ( file-info -- ? ) permissions>> group-write? ;
|
||||
M: file-info group-execute? ( file-info -- ? ) permissions>> group-execute? ;
|
||||
M: file-info other-read? ( file-info -- ? ) permissions>> other-read? ;
|
||||
M: file-info other-write? ( file-info -- ? ) permissions>> other-write? ;
|
||||
M: file-info other-execute? ( file-info -- ? ) permissions>> other-execute? ;
|
||||
|
||||
M: string uid? ( path -- ? ) UID file-mode? ;
|
||||
M: string gid? ( path -- ? ) GID file-mode? ;
|
||||
M: string sticky? ( path -- ? ) STICKY file-mode? ;
|
||||
M: string user-read? ( path -- ? ) USER-READ file-mode? ;
|
||||
M: string user-write? ( path -- ? ) USER-WRITE file-mode? ;
|
||||
M: string user-execute? ( path -- ? ) USER-EXECUTE file-mode? ;
|
||||
M: string group-read? ( path -- ? ) GROUP-READ file-mode? ;
|
||||
M: string group-write? ( path -- ? ) GROUP-WRITE file-mode? ;
|
||||
M: string group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ;
|
||||
M: string other-read? ( path -- ? ) OTHER-READ file-mode? ;
|
||||
M: string other-write? ( path -- ? ) OTHER-WRITE file-mode? ;
|
||||
M: string other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ;
|
||||
|
||||
: set-uid ( path ? -- ) UID swap chmod-set-bit ;
|
||||
: set-gid ( path ? -- ) GID swap chmod-set-bit ;
|
||||
|
|
@ -255,3 +316,5 @@ M: string set-file-group ( path string -- )
|
|||
|
||||
: file-group-name ( path -- string )
|
||||
file-group-id group-name ;
|
||||
|
||||
M: unix home "HOME" os-env ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces math system sequences debugger
|
||||
continuations arrays assocs combinators alien.c-types strings
|
||||
threads accessors
|
||||
threads accessors environment
|
||||
io io.backend io.launcher io.ports io.files
|
||||
io.files.private io.unix.files io.unix.backend
|
||||
io.unix.launcher.parser
|
||||
|
|
|
|||
|
|
@ -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+
|
||||
|
|
@ -218,6 +246,21 @@ M: winnt file-info ( path -- info )
|
|||
M: winnt link-info ( path -- info )
|
||||
file-info ;
|
||||
|
||||
TUPLE: winnt-file-system-info < file-system-info
|
||||
total-bytes total-free-bytes ;
|
||||
|
||||
M: winnt file-system-info ( path -- file-system-info )
|
||||
normalize-path
|
||||
dup file-info directory? [ parent-directory ] unless
|
||||
"ULARGE_INTEGER" <c-object>
|
||||
"ULARGE_INTEGER" <c-object>
|
||||
"ULARGE_INTEGER" <c-object>
|
||||
[ GetDiskFreeSpaceEx win32-error=0/f ] 3keep
|
||||
\ winnt-file-system-info new
|
||||
swap *ulonglong >>total-free-bytes
|
||||
swap *ulonglong >>total-bytes
|
||||
swap *ulonglong >>free-space ;
|
||||
|
||||
: file-times ( path -- timestamp timestamp timestamp )
|
||||
[
|
||||
normalize-path open-existing &dispose handle>>
|
||||
|
|
|
|||
|
|
@ -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 @@
|
|||
USING: continuations destructors io.buffers io.files io.backend
|
||||
io.timeouts io.ports io.windows io.windows.files
|
||||
io.windows.nt.backend windows windows.kernel32
|
||||
kernel libc math threads system
|
||||
kernel libc math threads system environment
|
||||
alien.c-types alien.arrays alien.strings sequences combinators
|
||||
combinators.short-circuit ascii splitting alien strings
|
||||
assocs namespaces make io.files.private accessors tr ;
|
||||
|
|
@ -59,3 +59,5 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
|
|||
M: winnt open-append
|
||||
[ dup file-info size>> ] [ drop 0 ] recover
|
||||
>r (open-append) r> >>ptr ;
|
||||
|
||||
M: winnt home "USERPROFILE" os-env ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -412,8 +410,6 @@ do-primitive alien-invoke alien-indirect alien-callback
|
|||
\ code-room { } { integer integer integer integer } define-primitive
|
||||
\ code-room make-flushable
|
||||
|
||||
\ os-env { string } { object } define-primitive
|
||||
|
||||
\ millis { } { integer } define-primitive
|
||||
\ millis make-flushable
|
||||
|
||||
|
|
@ -590,14 +586,6 @@ do-primitive alien-invoke alien-indirect alien-callback
|
|||
|
||||
\ set-innermost-frame-quot { quotation callstack } { } define-primitive
|
||||
|
||||
\ (os-envs) { } { array } define-primitive
|
||||
|
||||
\ set-os-env { string string } { } define-primitive
|
||||
|
||||
\ unset-os-env { string } { } define-primitive
|
||||
|
||||
\ (set-os-envs) { array } { } define-primitive
|
||||
|
||||
\ dll-valid? { object } { object } define-primitive
|
||||
|
||||
\ modify-code-heap { array object } { } define-primitive
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
IN: tools.deploy.tests
|
||||
USING: tools.test system io.files kernel tools.deploy.config
|
||||
tools.deploy.backend math sequences io.launcher arrays
|
||||
namespaces continuations layouts accessors ;
|
||||
namespaces continuations layouts accessors io.encodings.ascii
|
||||
urls math.parser ;
|
||||
|
||||
: shake-and-bake ( vocab -- )
|
||||
[ "test.image" temp-file delete-file ] ignore-errors
|
||||
|
|
@ -38,7 +39,7 @@ namespaces continuations layouts accessors ;
|
|||
! [ ] [ "tetris" shake-and-bake ] unit-test
|
||||
!
|
||||
! [ t ] [ 1500000 small-enough? ] unit-test
|
||||
!
|
||||
|
||||
[ ] [ "bunny" shake-and-bake ] unit-test
|
||||
|
||||
[ t ] [ 2500000 small-enough? ] unit-test
|
||||
|
|
@ -71,22 +72,24 @@ M: quit-responder call-responder*
|
|||
: add-quot-responder ( responder -- responder )
|
||||
quit-responder "quit" add-responder ;
|
||||
|
||||
: test-httpd ( -- )
|
||||
#! Return as soon as server is running.
|
||||
<http-server>
|
||||
1237 >>insecure
|
||||
f >>secure
|
||||
start-server* ;
|
||||
: test-httpd ( responder -- )
|
||||
[
|
||||
main-responder set
|
||||
<http-server>
|
||||
0 >>insecure
|
||||
f >>secure
|
||||
dup start-server*
|
||||
sockets>> first addr>> port>>
|
||||
dup number>string "resource:temp/port-number" ascii set-file-contents
|
||||
] with-scope
|
||||
"port" set ;
|
||||
|
||||
[ ] [
|
||||
[
|
||||
<dispatcher>
|
||||
add-quot-responder
|
||||
"resource:basis/http/test" <static> >>default
|
||||
main-responder set
|
||||
<dispatcher>
|
||||
add-quot-responder
|
||||
"resource:basis/http/test" <static> >>default
|
||||
|
||||
test-httpd
|
||||
] with-scope
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -94,7 +97,10 @@ M: quit-responder call-responder*
|
|||
run-temp-image
|
||||
] unit-test
|
||||
|
||||
[ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test
|
||||
: add-port ( url -- url' )
|
||||
>url clone "port" get >>port ;
|
||||
|
||||
[ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
|
||||
|
||||
[ ] [
|
||||
"tools.deploy.test.6" shake-and-bake
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
IN: tools.deploy.test.5
|
||||
USING: http.client kernel ;
|
||||
USING: accessors urls io.encodings.ascii io.files math.parser
|
||||
http.client kernel ;
|
||||
|
||||
: deploy-test-5 ( -- )
|
||||
"http://localhost:1237/foo.html" http-get 2drop ;
|
||||
URL" http://localhost/foo.html" clone
|
||||
"resource:port-number" ascii file-contents string>number >>port
|
||||
http-get 2drop ;
|
||||
|
||||
MAIN: deploy-test-5
|
||||
|
|
|
|||
|
|
@ -16,13 +16,18 @@ ERROR: vocab-name-contains-dot path ;
|
|||
ERROR: no-vocab vocab ;
|
||||
|
||||
<PRIVATE
|
||||
: root? ( string -- ? )
|
||||
vocab-roots get member? ;
|
||||
|
||||
: root? ( string -- ? ) vocab-roots get member? ;
|
||||
|
||||
: length-changes? ( seq quot -- ? )
|
||||
dupd call [ length ] bi@ = not ; inline
|
||||
|
||||
: check-vocab-name ( string -- string )
|
||||
dup dup [ CHAR: . = ] trim [ length ] bi@ =
|
||||
[ vocab-name-contains-dot ] unless
|
||||
dup [ [ CHAR: . = ] trim ] length-changes?
|
||||
[ vocab-name-contains-dot ] when
|
||||
|
||||
".." over subseq? [ vocab-name-contains-dot ] when
|
||||
|
||||
dup [ path-separator? ] contains?
|
||||
[ vocab-name-contains-separator ] when ;
|
||||
|
||||
|
|
@ -43,8 +48,11 @@ ERROR: no-vocab vocab ;
|
|||
: scaffolding ( path -- )
|
||||
"Creating scaffolding for " write <pathname> . ;
|
||||
|
||||
: (scaffold-path) ( path string -- path )
|
||||
dupd [ file-name ] dip append append-path ;
|
||||
|
||||
: scaffold-path ( path string -- path ? )
|
||||
dupd [ file-name ] dip append append-path
|
||||
(scaffold-path)
|
||||
dup exists? [ dup not-scaffolding f ] [ dup scaffolding t ] if ;
|
||||
|
||||
: scaffold-copyright ( -- )
|
||||
|
|
@ -205,14 +213,15 @@ ERROR: no-vocab vocab ;
|
|||
|
||||
: check-vocab ( vocab -- vocab )
|
||||
dup find-vocab-root [ no-vocab ] unless ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: link-vocab ( vocab -- )
|
||||
check-vocab
|
||||
"Edit documentation: " write
|
||||
[ find-vocab-root ] keep
|
||||
[ append-path ] keep "-docs.factor" append append-path
|
||||
<pathname> . ;
|
||||
[ find-vocab-root ]
|
||||
[ vocab>scaffold-path ] bi
|
||||
"-docs.factor" (scaffold-path) <pathname> . ;
|
||||
|
||||
: help. ( word -- )
|
||||
[ (help.) ] [ nl vocabulary>> link-vocab ] bi ;
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ SYMBOL: failures
|
|||
error-continuation get 3array ;
|
||||
|
||||
: failure ( error what -- )
|
||||
"--> test failed!" print
|
||||
<failure> failures get push ;
|
||||
|
||||
SYMBOL: this-test
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: continuations documents ui.tools.interactor
|
|||
ui.tools.listener hashtables kernel namespaces parser sequences
|
||||
tools.test ui.commands ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.panes vocabs words tools.test.ui slots.private
|
||||
threads arrays generic threads accessors listener ;
|
||||
threads arrays generic threads accessors listener math ;
|
||||
IN: ui.tools.listener.tests
|
||||
|
||||
[ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
|
||||
|
|
@ -51,3 +51,5 @@ IN: ui.tools.listener.tests
|
|||
|
||||
[ ] [ "listener" get com-end ] unit-test
|
||||
] with-grafted-gadget
|
||||
|
||||
[ ] [ \ + <pane> <interactor> interactor-use use-if-necessary ] unit-test
|
||||
|
|
|
|||
|
|
@ -101,8 +101,8 @@ M: engine-word word-completion-string
|
|||
"engine-generic" word-prop word-completion-string ;
|
||||
|
||||
: use-if-necessary ( word seq -- )
|
||||
over vocabulary>> [
|
||||
2dup assoc-stack pick = [ 2drop ] [
|
||||
over vocabulary>> over and [
|
||||
2dup [ assoc-stack ] keep = [ 2drop ] [
|
||||
>r vocabulary>> vocab-words r> push
|
||||
] if
|
||||
] [ 2drop ] if ;
|
||||
|
|
@ -114,9 +114,10 @@ M: engine-word word-completion-string
|
|||
2bi ;
|
||||
|
||||
: quot-action ( interactor -- lines )
|
||||
dup control-value
|
||||
dup "\n" join pick add-interactor-history
|
||||
swap select-all ;
|
||||
[ control-value ] keep
|
||||
[ [ "\n" join ] dip add-interactor-history ]
|
||||
[ select-all ]
|
||||
2bi ;
|
||||
|
||||
TUPLE: stack-display < track ;
|
||||
|
||||
|
|
|
|||
|
|
@ -40,11 +40,11 @@ IN: ui.tools
|
|||
|
||||
: resize-workspace ( workspace -- )
|
||||
dup sizes>> over control-value zero? [
|
||||
1/5 1 pick set-nth
|
||||
4/5 2 rot set-nth
|
||||
1/5 over set-second
|
||||
4/5 swap set-third
|
||||
] [
|
||||
2/3 1 pick set-nth
|
||||
1/3 2 rot set-nth
|
||||
2/3 over set-second
|
||||
1/3 swap set-third
|
||||
] if relayout ;
|
||||
|
||||
M: workspace model-changed
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@ assocs kernel math namespaces opengl sequences strings x11.xlib
|
|||
x11.events x11.xim x11.glx x11.clipboard x11.constants
|
||||
x11.windows io.encodings.string io.encodings.ascii
|
||||
io.encodings.utf8 combinators debugger command-line qualified
|
||||
math.vectors classes.tuple opengl.gl threads math.geometry.rect ;
|
||||
QUALIFIED: system
|
||||
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
||||
environment ;
|
||||
IN: ui.x11
|
||||
|
||||
SINGLETON: x11-ui-backend
|
||||
|
|
@ -262,5 +262,5 @@ M: x11-ui-backend beep ( -- )
|
|||
|
||||
x11-ui-backend ui-backend set-global
|
||||
|
||||
[ "DISPLAY" system:os-env "ui" "listener" ? ]
|
||||
[ "DISPLAY" os-env "ui" "listener" ? ]
|
||||
main-vocab-hook set-global
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings io.encodings.utf8
|
|||
io.unix.backend kernel math sequences splitting unix strings
|
||||
combinators.short-circuit byte-arrays combinators qualified
|
||||
accessors math.parser fry assocs namespaces continuations
|
||||
unix.users ;
|
||||
unix.users unix.utilities ;
|
||||
IN: unix.groups
|
||||
|
||||
QUALIFIED: grouping
|
||||
|
|
@ -18,12 +18,7 @@ GENERIC: group-struct ( obj -- group )
|
|||
<PRIVATE
|
||||
|
||||
: group-members ( group-struct -- seq )
|
||||
group-gr_mem
|
||||
[ dup { [ ] [ *void* ] } 1&& ]
|
||||
[
|
||||
dup *void* utf8 alien>string
|
||||
[ alien-address "char**" heap-size + <alien> ] dip
|
||||
] [ ] produce nip ;
|
||||
group-gr_mem utf8 alien>strings ;
|
||||
|
||||
: (group-struct) ( id -- group-struct id group-struct byte-array length void* )
|
||||
"group" <c-object> tuck 4096
|
||||
|
|
|
|||
|
|
@ -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,6 @@
|
|||
USING: kernel alien.c-types alien.strings sequences math alien.syntax unix
|
||||
vectors kernel namespaces continuations threads assocs vectors
|
||||
io.unix.backend io.encodings.utf8 ;
|
||||
vectors kernel namespaces continuations threads assocs vectors
|
||||
io.unix.backend io.encodings.utf8 unix.utilities ;
|
||||
IN: unix.process
|
||||
|
||||
! Low-level Unix process launching utilities. These are used
|
||||
|
|
@ -15,17 +15,16 @@ FUNCTION: int execv ( char* path, char** argv ) ;
|
|||
FUNCTION: int execvp ( char* path, char** argv ) ;
|
||||
FUNCTION: int execve ( char* path, char** argv, char** envp ) ;
|
||||
|
||||
: >argv ( seq -- alien )
|
||||
[ utf8 malloc-string ] map f suffix >c-void*-array ;
|
||||
|
||||
: exec ( pathname argv -- int )
|
||||
[ utf8 malloc-string ] [ >argv ] bi* execv ;
|
||||
[ utf8 malloc-string ] [ utf8 strings>alien ] bi* execv ;
|
||||
|
||||
: exec-with-path ( filename argv -- int )
|
||||
[ utf8 malloc-string ] [ >argv ] bi* execvp ;
|
||||
[ utf8 malloc-string ] [ utf8 strings>alien ] bi* execvp ;
|
||||
|
||||
: exec-with-env ( filename argv envp -- int )
|
||||
[ utf8 malloc-string ] [ >argv ] [ >argv ] tri* execve ;
|
||||
[ utf8 malloc-string ]
|
||||
[ utf8 strings>alien ]
|
||||
[ utf8 strings>alien ] tri* execve ;
|
||||
|
||||
: exec-args ( seq -- int )
|
||||
[ first ] [ ] bi exec ;
|
||||
|
|
@ -99,4 +98,4 @@ FUNCTION: pid_t wait ( int* status ) ;
|
|||
FUNCTION: pid_t waitpid ( pid_t wpid, int* status, int options ) ;
|
||||
|
||||
: wait-for-pid ( pid -- status )
|
||||
0 <int> [ 0 waitpid drop ] keep *int WEXITSTATUS ;
|
||||
0 <int> [ 0 waitpid drop ] keep *int WEXITSTATUS ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,4 @@
|
|||
|
||||
USING: kernel alien.syntax math ;
|
||||
|
||||
IN: unix.stat
|
||||
|
||||
! Ubuntu 8.04 32-bit
|
||||
|
|
@ -24,8 +22,6 @@ C-STRUCT: stat
|
|||
{ "ulong" "unused4" }
|
||||
{ "ulong" "unused5" } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
||||
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,11 +1,8 @@
|
|||
|
||||
USING: layouts combinators vocabs.loader ;
|
||||
|
||||
USING: alien.syntax layouts combinators vocabs.loader ;
|
||||
IN: unix.stat
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: layouts combinators vocabs.loader ;
|
||||
USING: layouts combinators vocabs.loader alien.syntax ;
|
||||
IN: unix.stat
|
||||
|
||||
cell-bits {
|
||||
|
|
|
|||
|
|
@ -18,6 +18,12 @@ FUNCTION: int chmod ( char* path, mode_t mode ) ;
|
|||
FUNCTION: int fchmod ( int fd, mode_t mode ) ;
|
||||
FUNCTION: int mkdir ( char* path, mode_t mode ) ;
|
||||
|
||||
C-STRUCT: fsid
|
||||
{ { "int" 2 } "__val" } ;
|
||||
|
||||
TYPEDEF: fsid __fsid_t
|
||||
TYPEDEF: fsid fsid_t
|
||||
|
||||
<< os {
|
||||
{ linux [ "unix.stat.linux" require ] }
|
||||
{ macosx [ "unix.stat.macosx" require ] }
|
||||
|
|
@ -27,11 +33,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,52 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel unix io.files math accessors
|
||||
combinators system io.backend alien.c-types ;
|
||||
IN: unix.statfs.freebsd
|
||||
|
||||
: ST_RDONLY 1 ; inline
|
||||
: ST_NOSUID 2 ; inline
|
||||
|
||||
C-STRUCT: statvfs
|
||||
{ "fsblkcnt_t" "f_bavail" }
|
||||
{ "fsblkcnt_t" "f_bfree" }
|
||||
{ "fsblkcnt_t" "f_blocks" }
|
||||
{ "fsfilcnt_t" "f_favail" }
|
||||
{ "fsfilcnt_t" "f_ffree" }
|
||||
{ "fsfilcnt_t" "f_files" }
|
||||
{ "ulong" "f_bsize" }
|
||||
{ "ulong" "f_flag" }
|
||||
{ "ulong" "f_frsize" }
|
||||
{ "ulong" "f_fsid" }
|
||||
{ "ulong" "f_namemax" } ;
|
||||
|
||||
FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
|
||||
|
||||
TUPLE: freebsd-file-system-info < file-system-info
|
||||
bavail bfree blocks favail ffree ffiles
|
||||
bsize flag frsize fsid namemax ;
|
||||
|
||||
M: freebsd >file-system-info ( struct -- statfs )
|
||||
[ \ freebsd-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statvfs-f_bsize ]
|
||||
[ statvfs-f_bavail ] bi * >>free-space
|
||||
]
|
||||
[ statvfs-f_bavail >>bavail ]
|
||||
[ statvfs-f_bfree >>bfree ]
|
||||
[ statvfs-f_blocks >>blocks ]
|
||||
[ statvfs-f_favail >>favail ]
|
||||
[ statvfs-f_ffree >>ffree ]
|
||||
[ statvfs-f_files >>files ]
|
||||
[ statvfs-f_bsize >>bsize ]
|
||||
[ statvfs-f_flag >>flag ]
|
||||
[ statvfs-f_frsize >>frsize ]
|
||||
[ statvfs-f_fsid >>fsid ]
|
||||
[ statvfs-f_namemax >>namemax ]
|
||||
} cleave ;
|
||||
|
||||
M: freebsd file-system-info ( path -- byte-array )
|
||||
normalize-path
|
||||
"statvfs" <c-object> tuck statvfs io-error
|
||||
>file-system-info ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
! 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 layouts vocabs.loader
|
||||
alien.syntax ;
|
||||
IN: unix.statfs.linux
|
||||
|
||||
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" } ;
|
||||
|
||||
FUNCTION: int statfs ( char* path, statfs* buf ) ;
|
||||
|
||||
TUPLE: linux32-file-system-info < file-system-info
|
||||
type bsize blocks bfree bavail files ffree fsid
|
||||
namelen frsize spare ;
|
||||
|
||||
M: linux >file-system-info ( struct -- statfs )
|
||||
[ \ linux32-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statfs-f_bsize ]
|
||||
[ statfs-f_bavail ] bi * >>free-space
|
||||
]
|
||||
[ statfs-f_type >>type ]
|
||||
[ statfs-f_bsize >>bsize ]
|
||||
[ statfs-f_blocks >>blocks ]
|
||||
[ statfs-f_bfree >>bfree ]
|
||||
[ statfs-f_bavail >>bavail ]
|
||||
[ statfs-f_files >>files ]
|
||||
[ statfs-f_ffree >>ffree ]
|
||||
[ statfs-f_fsid >>fsid ]
|
||||
[ statfs-f_namelen >>namelen ]
|
||||
} cleave ;
|
||||
|
||||
M: linux file-system-info ( path -- byte-array )
|
||||
normalize-path
|
||||
"statfs" <c-object> tuck statfs io-error
|
||||
>file-system-info ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
! 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 layouts vocabs.loader
|
||||
alien.syntax ;
|
||||
IN: unix.statfs.linux
|
||||
|
||||
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 ) ;
|
||||
|
||||
TUPLE: linux64-file-system-info < file-system-info
|
||||
type bsize blocks bfree bavail files ffree fsid
|
||||
namelen frsize spare ;
|
||||
|
||||
M: linux >file-system-info ( struct -- statfs )
|
||||
[ \ linux64-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
|
||||
>file-system-info ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
! 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 layouts vocabs.loader ;
|
||||
IN: unix.statfs.linux
|
||||
|
||||
cell-bits {
|
||||
{ 32 [ "unix.statfs.linux.32" require ] }
|
||||
{ 64 [ "unix.statfs.linux.64" require ] }
|
||||
} case
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,165 @@
|
|||
! 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
|
||||
math.bitwise alien.syntax ;
|
||||
IN: unix.statfs.macosx
|
||||
|
||||
: 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 ) ;
|
||||
|
||||
|
||||
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 ;
|
||||
|
||||
M: macosx >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
|
||||
>file-system-info ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel io.files unix.stat math unix
|
||||
combinators system io.backend accessors alien.c-types
|
||||
io.encodings.utf8 alien.strings unix.types ;
|
||||
IN: unix.statfs.netbsd
|
||||
|
||||
: _VFS_NAMELEN 32 ; inline
|
||||
: _VFS_MNAMELEN 1024 ; inline
|
||||
|
||||
C-STRUCT: statvfs
|
||||
{ "ulong" "f_flag" }
|
||||
{ "ulong" "f_bsize" }
|
||||
{ "ulong" "f_frsize" }
|
||||
{ "ulong" "f_iosize" }
|
||||
{ "fsblkcnt_t" "f_blocks" }
|
||||
{ "fsblkcnt_t" "f_bfree" }
|
||||
{ "fsblkcnt_t" "f_bavail" }
|
||||
{ "fsblkcnt_t" "f_bresvd" }
|
||||
{ "fsfilcnt_t" "f_files" }
|
||||
{ "fsfilcnt_t" "f_ffree" }
|
||||
{ "fsfilcnt_t" "f_favail" }
|
||||
{ "fsfilcnt_t" "f_fresvd" }
|
||||
{ "uint64_t" "f_syncreads" }
|
||||
{ "uint64_t" "f_syncwrites" }
|
||||
{ "uint64_t" "f_asyncreads" }
|
||||
{ "uint64_t" "f_asyncwrites" }
|
||||
{ "fsid_t" "f_fsidx" }
|
||||
{ "ulong" "f_fsid" }
|
||||
{ "ulong" "f_namemax" }
|
||||
{ "uid_t" "f_owner" }
|
||||
{ { "uint32_t" 4 } "f_spare" }
|
||||
{ { "char" _VFS_NAMELEN } "f_fstypename" }
|
||||
{ { "char" _VFS_NAMELEN } "f_mntonname" }
|
||||
{ { "char" _VFS_NAMELEN } "f_mntfromname" } ;
|
||||
|
||||
FUNCTION: int statvfs ( char* path, statvfs *buf ) ;
|
||||
|
||||
TUPLE: netbsd-file-system-info < file-system-info
|
||||
flag bsize frsize io-size
|
||||
blocks blocks-free blocks-available blocks-reserved
|
||||
files ffree sync-reads sync-writes async-reads async-writes
|
||||
fsidx fsid namemax owner spare fstype mnotonname mntfromname
|
||||
file-system-type-name mount-from ;
|
||||
|
||||
M: netbsd >file-system-info ( byte-array -- netbsd-file-system-info )
|
||||
[ \ netbsd-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statvfs-f_bsize ]
|
||||
[ statvfs-f_bavail ] bi * >>free-space
|
||||
]
|
||||
[ statvfs-f_flag >>flag ]
|
||||
[ statvfs-f_bsize >>bsize ]
|
||||
[ statvfs-f_frsize >>frsize ]
|
||||
[ statvfs-f_iosize >>io-size ]
|
||||
[ statvfs-f_blocks >>blocks ]
|
||||
[ statvfs-f_bfree >>blocks-free ]
|
||||
[ statvfs-f_favail >>blocks-available ]
|
||||
[ statvfs-f_fresvd >>blocks-reserved ]
|
||||
[ statvfs-f_files >>files ]
|
||||
[ statvfs-f_ffree >>ffree ]
|
||||
[ statvfs-f_syncreads >>sync-reads ]
|
||||
[ statvfs-f_syncwrites >>sync-writes ]
|
||||
[ statvfs-f_asyncreads >>async-reads ]
|
||||
[ statvfs-f_asyncwrites >>async-writes ]
|
||||
[ statvfs-f_fsidx >>fsidx ]
|
||||
[ statvfs-f_namemax >>namemax ]
|
||||
[ statvfs-f_owner >>owner ]
|
||||
[ statvfs-f_spare >>spare ]
|
||||
[ statvfs-f_fstypename utf8 alien>string >>file-system-type-name ]
|
||||
[ statvfs-f_mntonname utf8 alien>string >>mount-on ]
|
||||
[ statvfs-f_mntfromname utf8 alien>string >>mount-from ]
|
||||
} cleave ;
|
||||
|
||||
M: netbsd file-system-info
|
||||
normalize-path "statvfs" <c-object> tuck statvfs io-error
|
||||
>file-system-info ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel unix ;
|
||||
IN: unix.statfs.openbsd.32
|
||||
|
||||
: MFSNAMELEN 16 ; inline
|
||||
: MNAMELEN 90 ; inline
|
||||
|
||||
C-STRUCT: statfs
|
||||
{ "u_int32_t" "f_flags" }
|
||||
{ "int32_t" "f_bsize" }
|
||||
{ "u_int32_t" "f_iosize" }
|
||||
{ "u_int32_t" "f_blocks" }
|
||||
{ "u_int32_t" "f_bfree" }
|
||||
{ "int32_t" "f_bavail" }
|
||||
{ "u_int32_t" "f_files" }
|
||||
{ "u_int32_t" "f_ffree" }
|
||||
{ "fsid_t" "f_fsid" }
|
||||
{ "uid_t" "f_owner" }
|
||||
{ "u_int32_t" "f_syncwrites" }
|
||||
{ "u_int32_t" "f_asyncwrites" }
|
||||
{ "u_int32_t" "f_ctime" }
|
||||
{ { "u_int32_t" 3 } "f_spare" }
|
||||
{ { "char" MFSNAMELEN } "f_fstypename" }
|
||||
{ { "char" MNAMELEN } "f_mntonname" }
|
||||
{ { "char" MNAMELEN } "f_mntfromname" } ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax unix ;
|
||||
IN: unix.statfs.openbsd.64
|
||||
|
||||
: MFSNAMELEN 16 ; inline
|
||||
: MNAMELEN 90 ; inline
|
||||
|
||||
C-STRUCT: statfss
|
||||
{ "u_int32_t" "f_flags" }
|
||||
{ "u_int32_t" "f_bsize" }
|
||||
{ "u_int32_t" "f_iosize" }
|
||||
{ "u_int64_t" "f_blocks" }
|
||||
{ "u_int64_t" "f_bfree" }
|
||||
{ "int64_t" "f_bavail" }
|
||||
{ "u_int64_t" "f_files" }
|
||||
{ "u_int64_t" "f_ffree" }
|
||||
{ "int64_t" "f_favail" }
|
||||
{ "u_int64_t" "f_syncwrites" }
|
||||
{ "u_int64_t" "f_syncreads" }
|
||||
{ "u_int64_t" "f_asyncwrites" }
|
||||
{ "u_int64_t" "f_asyncreads" }
|
||||
{ "fsid_t" "f_fsid" }
|
||||
{ "u_int32_t" "f_namemax" }
|
||||
{ "uid_t" "f_owner" }
|
||||
{ "u_int32_t" "f_ctime" }
|
||||
{ { "u_int32_t" 3 } " f_spare" }
|
||||
{ { "char" MFSNAMELEN } "f_fstypename" }
|
||||
{ { "char" MNAMELEN } "f_mntonname" }
|
||||
{ { "char" MNAMELEN } "f_mntfromname" }
|
||||
{ { "char" 512 } "mount_info" } ;
|
||||
! { "mount_info" "mount_info" } ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax accessors combinators kernel io.files
|
||||
unix.types math system io.backend alien.c-types unix ;
|
||||
IN: unix.statfs.openbsd
|
||||
|
||||
C-STRUCT: statvfs
|
||||
{ "ulong" "f_bsize" }
|
||||
{ "ulong" "f_frsize" }
|
||||
{ "fsblkcnt_t" "f_blocks" }
|
||||
{ "fsblkcnt_t" "f_bfree" }
|
||||
{ "fsblkcnt_t" "f_bavail" }
|
||||
{ "fsfilcnt_t" "f_files" }
|
||||
{ "fsfilcnt_t" "f_ffree" }
|
||||
{ "fsfilcnt_t" "f_favail" }
|
||||
{ "ulong" "f_fsid" }
|
||||
{ "ulong" "f_flag" }
|
||||
{ "ulong" "f_namemax" } ;
|
||||
|
||||
: ST_RDONLY 1 ; inline
|
||||
: ST_NOSUID 2 ; inline
|
||||
|
||||
FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
|
||||
|
||||
TUPLE: openbsd-file-system-info < file-system-info
|
||||
bsize frsize blocks bfree bavail files ffree favail
|
||||
fsid flag namemax ;
|
||||
|
||||
M: openbsd >file-system-info ( struct -- statfs )
|
||||
[ \ openbsd-file-system-info new ] dip
|
||||
{
|
||||
[
|
||||
[ statvfs-f_bsize ]
|
||||
[ statvfs-f_bavail ] bi * >>free-space
|
||||
]
|
||||
[ statvfs-f_bsize >>bsize ]
|
||||
[ statvfs-f_frsize >>frsize ]
|
||||
[ statvfs-f_blocks >>blocks ]
|
||||
[ statvfs-f_bfree >>bfree ]
|
||||
[ statvfs-f_bavail >>bavail ]
|
||||
[ statvfs-f_files >>files ]
|
||||
[ statvfs-f_ffree >>ffree ]
|
||||
[ statvfs-f_favail >>favail ]
|
||||
[ statvfs-f_fsid >>fsid ]
|
||||
[ statvfs-f_flag >>flag ]
|
||||
[ statvfs-f_namemax >>namemax ]
|
||||
} cleave ;
|
||||
|
||||
M: openbsd file-system-info ( path -- byte-array )
|
||||
normalize-path
|
||||
"statvfs" <c-object> tuck statvfs io-error
|
||||
>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,33 @@
|
|||
! 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 ;
|
||||
|
||||
HOOK: >file-system-info os ( struct -- statfs )
|
||||
|
||||
: 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,21 @@ 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
|
||||
|
||||
TYPEDEF: ssize_t __SWORD_TYPE
|
||||
TYPEDEF: ulonglong __fsblkcnt64_t
|
||||
TYPEDEF: ulonglong __fsfilcnt64_t
|
||||
|
|
|
|||
|
|
@ -3,24 +3,12 @@ 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
|
||||
TYPEDEF: __uint32_t nlink_t
|
||||
TYPEDEF: __uint32_t uid_t
|
||||
TYPEDEF: __uint32_t __uid_t
|
||||
TYPEDEF: __uint32_t gid_t
|
||||
TYPEDEF: __int64_t off_t
|
||||
TYPEDEF: __int64_t blkcnt_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
|
||||
|
|
|
|||
|
|
@ -6,6 +6,11 @@ TYPEDEF: void* caddr_t
|
|||
TYPEDEF: uint in_addr_t
|
||||
TYPEDEF: uint socklen_t
|
||||
|
||||
TYPEDEF: __uint64_t fsblkcnt_t
|
||||
TYPEDEF: fsblkcnt_t __fsblkcnt_t
|
||||
TYPEDEF: __uint64_t fsfilcnt_t
|
||||
TYPEDEF: fsfilcnt_t __fsfilcnt_t
|
||||
|
||||
TYPEDEF: char int8_t
|
||||
TYPEDEF: short int16_t
|
||||
TYPEDEF: int int32_t
|
||||
|
|
@ -16,6 +21,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 ;
|
||||
|
||||
|
|
@ -105,6 +106,8 @@ FUNCTION: int getdtablesize ;
|
|||
FUNCTION: gid_t getegid ;
|
||||
FUNCTION: uid_t geteuid ;
|
||||
FUNCTION: gid_t getgid ;
|
||||
FUNCTION: char* getenv ( char* name ) ;
|
||||
|
||||
FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ;
|
||||
FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ;
|
||||
FUNCTION: passwd* getpwent ( ) ;
|
||||
|
|
@ -134,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
|
||||
|
|
@ -155,6 +160,9 @@ FUNCTION: int pipe ( int* filedes ) ;
|
|||
FUNCTION: void* popen ( char* command, char* type ) ;
|
||||
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
|
||||
|
||||
FUNCTION: dirent* readdir ( DIR* dirp ) ;
|
||||
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
|
||||
|
|
@ -171,6 +179,8 @@ FUNCTION: int rename ( char* from, char* to ) ;
|
|||
FUNCTION: int rmdir ( char* path ) ;
|
||||
FUNCTION: int select ( int nfds, void* readfds, void* writefds, void* exceptfds, timeval* timeout ) ;
|
||||
FUNCTION: ssize_t sendto ( int s, void* buf, size_t len, int flags, sockaddr-in* to, socklen_t tolen ) ;
|
||||
FUNCTION: int setenv ( char* name, char* value, int overwrite ) ;
|
||||
FUNCTION: int unsetenv ( char* name ) ;
|
||||
FUNCTION: int setegid ( gid_t egid ) ;
|
||||
FUNCTION: int seteuid ( uid_t euid ) ;
|
||||
FUNCTION: int setgid ( gid_t gid ) ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.strings
|
||||
combinators.short-circuit fry kernel layouts sequences ;
|
||||
IN: unix.utilities
|
||||
|
||||
: more? ( alien -- ? )
|
||||
{ [ ] [ *void* ] } 1&& ;
|
||||
|
||||
: advance ( void* -- void* )
|
||||
cell swap <displaced-alien> ;
|
||||
|
||||
: alien>strings ( alien encoding -- strings )
|
||||
[ [ dup more? ] ] dip
|
||||
'[ [ advance ] [ *void* _ alien>string ] bi ]
|
||||
[ ] produce nip ;
|
||||
|
||||
: strings>alien ( strings encoding -- alien )
|
||||
'[ _ malloc-string ] map f suffix >c-void*-array ;
|
||||
|
|
@ -2,8 +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
|
||||
|
||||
|
|
|
|||
|
|
@ -838,7 +838,8 @@ ALIAS: FindNextFile FindNextFileW
|
|||
! FUNCTION: FormatMessageW
|
||||
! FUNCTION: FreeConsole
|
||||
! FUNCTION: FreeEnvironmentStringsA
|
||||
! FUNCTION: FreeEnvironmentStringsW
|
||||
FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
|
||||
ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
|
||||
! FUNCTION: FreeLibrary
|
||||
! FUNCTION: FreeLibraryAndExitThread
|
||||
! FUNCTION: FreeResource
|
||||
|
|
@ -927,17 +928,19 @@ FUNCTION: HANDLE GetCurrentThread ( ) ;
|
|||
! FUNCTION: GetDevicePowerState
|
||||
! FUNCTION: GetDiskFreeSpaceA
|
||||
! FUNCTION: GetDiskFreeSpaceExA
|
||||
! FUNCTION: GetDiskFreeSpaceExW
|
||||
FUNCTION: BOOL GetDiskFreeSpaceExW ( LPCTSTR lpDirectoryName, PULARGE_INTEGER pFreeBytesAvailable, PULARGE_INTEGER lpTotalNumberOfBytes, PULARGE_INTEGER lpTotalNumberOfFreeBytes ) ;
|
||||
ALIAS: GetDiskFreeSpaceEx GetDiskFreeSpaceExW
|
||||
! FUNCTION: GetDiskFreeSpaceW
|
||||
! FUNCTION: GetDllDirectoryA
|
||||
! FUNCTION: GetDllDirectoryW
|
||||
! FUNCTION: GetDriveTypeA
|
||||
! FUNCTION: GetDriveTypeW
|
||||
! FUNCTION: GetEnvironmentStrings
|
||||
FUNCTION: void* GetEnvironmentStringsW ( ) ;
|
||||
! FUNCTION: GetEnvironmentStringsA
|
||||
! FUNCTION: GetEnvironmentStringsW
|
||||
ALIAS: GetEnvironmentStrings GetEnvironmentStringsW
|
||||
! FUNCTION: GetEnvironmentVariableA
|
||||
! FUNCTION: GetEnvironmentVariableW
|
||||
FUNCTION: DWORD GetEnvironmentVariableW ( LPCTSTR lpName, LPTSTR lpBuffer, DWORD nSize ) ;
|
||||
ALIAS: GetEnvironmentVariable GetEnvironmentVariableW
|
||||
FUNCTION: BOOL GetExitCodeProcess ( HANDLE hProcess, LPDWORD lpExitCode ) ;
|
||||
! FUNCTION: GetExitCodeThread
|
||||
! FUNCTION: GetExpandedNameA
|
||||
|
|
@ -1418,7 +1421,8 @@ ALIAS: SetCurrentDirectory SetCurrentDirectoryW
|
|||
! FUNCTION: SetDllDirectoryW
|
||||
FUNCTION: BOOL SetEndOfFile ( HANDLE hFile ) ;
|
||||
! FUNCTION: SetEnvironmentVariableA
|
||||
! FUNCTION: SetEnvironmentVariableW
|
||||
FUNCTION: BOOL SetEnvironmentVariableW ( LPCTSTR key, LPCTSTR value ) ;
|
||||
ALIAS: SetEnvironmentVariable SetEnvironmentVariableW
|
||||
! FUNCTION: SetErrorMode
|
||||
! FUNCTION: SetEvent
|
||||
! FUNCTION: SetFileApisToANSI
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ TYPEDEF: char CHAR
|
|||
TYPEDEF: uchar UCHAR
|
||||
TYPEDEF: uchar BYTE
|
||||
|
||||
TYPEDEF: ushort wchar_t
|
||||
TYPEDEF: ushort wchar_t
|
||||
TYPEDEF: wchar_t WCHAR
|
||||
|
||||
TYPEDEF: short SHORT
|
||||
|
|
@ -62,14 +62,16 @@ TYPEDEF: ulonglong ULONGLONG
|
|||
TYPEDEF: longlong LONG64
|
||||
TYPEDEF: ulonglong DWORD64
|
||||
TYPEDEF: longlong LARGE_INTEGER
|
||||
TYPEDEF: ulonglong ULARGE_INTEGER
|
||||
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
|
||||
TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
|
||||
|
||||
TYPEDEF: WCHAR TCHAR
|
||||
TYPEDEF: TCHAR TBYTE
|
||||
TYPEDEF: wchar_t* LPCSTR
|
||||
TYPEDEF: wchar_t* LPWSTR
|
||||
|
||||
|
||||
TYPEDEF: WCHAR TCHAR
|
||||
TYPEDEF: LPWSTR LPTCH
|
||||
TYPEDEF: LPWSTR PTCH
|
||||
TYPEDEF: TCHAR TBYTE
|
||||
|
||||
TYPEDEF: WORD ATOM
|
||||
TYPEDEF: BYTE BOOLEAN
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue