Implement monitors for BSD

db4
Slava Pestov 2008-04-11 09:54:50 -05:00
parent 82d793b141
commit d132bce5a3
7 changed files with 113 additions and 29 deletions

View File

@ -42,13 +42,17 @@ HELP: +rename-file-old+
HELP: +rename-file-new+
{ $description "Indicates that a file has been renamed, and this is the new name." } ;
HELP: +rename-file+
{ $description "Indicates that a file has been renamed." } ;
ARTICLE: "io.monitors.descriptors" "File system change descriptors"
"Change descriptors output by " { $link next-change } ":"
{ $subsection +add-file+ }
{ $subsection +remove-file+ }
{ $subsection +modify-file+ }
{ $subsection +rename-file-old+ }
{ $subsection +rename-file-new+ } ;
{ $subsection +rename-file-new+ }
{ $subsection +rename-file+ } ;
ARTICLE: "io.monitors.platforms" "Monitors on different platforms"
"Whether the " { $snippet "path" } " output value of " { $link next-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is platform-specific. User code should not assume either case."

View File

@ -3,7 +3,7 @@ USING: io.monitors tools.test io.files system sequences
continuations namespaces concurrency.count-downs kernel io
threads calendar prettyprint ;
os wince? [
os { winnt linux macosx } member? [
[
[ "monitor-test" temp-file delete-tree ] ignore-errors
@ -88,4 +88,4 @@ os wince? [
[ ] [ "m" get dispose ] unit-test
] with-monitors
] unless
] when

View File

@ -45,6 +45,7 @@ SYMBOL: +remove-file+
SYMBOL: +modify-file+
SYMBOL: +rename-file-old+
SYMBOL: +rename-file-new+
SYMBOL: +rename-file+
: with-monitor ( path recursive? quot -- )
>r <monitor> r> with-disposal ; inline

3
extra/io/unix/backend/backend.factor Executable file → Normal file
View File

@ -203,3 +203,6 @@ M: mx-task do-io-task
: multiplexer-error ( n -- )
0 < [ err_no ignorable-error? [ (io-error) ] unless ] when ;
: ?flag ( n mask symbol -- n )
pick rot bitand 0 > [ , ] [ drop ] if ;

View File

@ -1,8 +1,21 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: io.unix.bsd
USING: io.backend io.unix.backend io.unix.select
namespaces system ;
USING: namespaces system kernel accessors assocs continuations
unix
io.backend io.unix.backend io.unix.select io.unix.kqueue io.monitors ;
M: bsd init-io ( -- )
<select-mx> mx set-global ;
<select-mx> mx set-global
<kqueue-mx> kqueue-mx set-global
kqueue-mx get-global <mx-port> <mx-task>
dup io-task-fd
[ mx get-global reads>> set-at ]
[ mx get-global writes>> set-at ] 2bi ;
M: bsd init-monitors ;
M: bsd dispose-monitors ;
M: bsd (monitor) ( path recursive? mailbox -- )
nip <vnode-monitor> ;

104
extra/io/unix/kqueue/kqueue.factor Executable file → Normal file
View File

@ -1,12 +1,14 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel io.nonblocking io.unix.backend
sequences assocs unix unix.time unix.kqueue unix.process math namespaces
combinators threads vectors io.launcher
io.unix.launcher ;
USING: alien.c-types kernel math math.bitfields namespaces
locals accessors combinators threads vectors hashtables
sequences assocs continuations
unix unix.time unix.kqueue unix.process
io.nonblocking io.unix.backend io.launcher io.unix.launcher
io.monitors ;
IN: io.unix.kqueue
TUPLE: kqueue-mx events ;
TUPLE: kqueue-mx events monitors ;
: max-events ( -- n )
#! We read up to 256 events at a time. This is an arbitrary
@ -15,8 +17,9 @@ TUPLE: kqueue-mx events ;
: <kqueue-mx> ( -- mx )
kqueue-mx construct-mx
kqueue dup io-error over set-mx-fd
max-events "kevent" <c-array> over set-kqueue-mx-events ;
H{ } clone >>monitors
kqueue dup io-error >>fd
max-events "kevent" <c-array> >>events ;
GENERIC: io-task-filter ( task -- n )
@ -24,14 +27,19 @@ M: input-task io-task-filter drop EVFILT_READ ;
M: output-task io-task-filter drop EVFILT_WRITE ;
GENERIC: io-task-fflags ( task -- n )
M: io-task io-task-fflags drop 0 ;
: make-kevent ( task flags -- event )
"kevent" <c-object>
tuck set-kevent-flags
over io-task-fd over set-kevent-ident
over io-task-fflags over set-kevent-fflags
swap io-task-filter over set-kevent-filter ;
: register-kevent ( kevent mx -- )
mx-fd swap 1 f 0 f kevent
fd>> swap 1 f 0 f kevent
0 < [ err_no ESRCH = [ (io-error) ] unless ] when ;
M: kqueue-mx register-io-task ( task mx -- )
@ -43,33 +51,52 @@ M: kqueue-mx unregister-io-task ( task mx -- )
swap EV_DELETE make-kevent swap register-kevent ;
: wait-kevent ( mx timespec -- n )
>r dup mx-fd f 0 roll kqueue-mx-events max-events r> kevent
>r [ fd>> f 0 ] keep events>> max-events r> kevent
dup multiplexer-error ;
: kevent-read-task ( mx fd -- )
over mx-reads at handle-io-task ;
:: kevent-read-task ( mx fd kevent -- )
mx fd mx reads>> at handle-io-task ;
: kevent-write-task ( mx fd -- )
over mx-reads at handle-io-task ;
:: kevent-write-task ( mx fd kevent -- )
mx fd mx writes>> at handle-io-task ;
: kevent-proc-task ( pid -- )
dup wait-for-pid swap find-process
:: kevent-proc-task ( mx pid kevent -- )
pid wait-for-pid
pid find-process
dup [ swap notify-exit ] [ 2drop ] if ;
: parse-action ( mask -- changed )
[
NOTE_DELETE +remove-file+ ?flag
NOTE_WRITE +modify-file+ ?flag
NOTE_EXTEND +modify-file+ ?flag
NOTE_ATTRIB +modify-file+ ?flag
NOTE_RENAME +rename-file+ ?flag
NOTE_REVOKE +remove-file+ ?flag
drop
] { } make prune ;
:: kevent-vnode-task ( mx kevent fd -- )
""
kevent kevent-fflags parse-action
fd mx monitors>> at queue-change ;
: handle-kevent ( mx kevent -- )
dup kevent-ident swap kevent-filter {
[ ] [ kevent-ident ] [ kevent-filter ] tri {
{ [ dup EVFILT_READ = ] [ drop kevent-read-task ] }
{ [ dup EVFILT_WRITE = ] [ drop kevent-write-task ] }
{ [ dup EVFILT_PROC = ] [ drop kevent-proc-task drop ] }
{ [ dup EVFILT_PROC = ] [ drop kevent-proc-task ] }
{ [ dup EVFILT_VNODE = ] [ drop kevent-vnode-task ] }
} cond ;
: handle-kevents ( mx n -- )
[ over kqueue-mx-events kevent-nth handle-kevent ] with each ;
[ over events>> kevent-nth handle-kevent ] with each ;
M: kqueue-mx wait-for-events ( ms mx -- )
swap dup [ make-timespec ] when
dupd wait-kevent handle-kevents ;
! Procs
: make-proc-kevent ( pid -- kevent )
"kevent" <c-object>
tuck set-kevent-ident
@ -77,5 +104,44 @@ M: kqueue-mx wait-for-events ( ms mx -- )
EVFILT_PROC over set-kevent-filter
NOTE_EXIT over set-kevent-fflags ;
: add-pid-task ( pid mx -- )
: register-pid-task ( pid mx -- )
swap make-proc-kevent swap register-kevent ;
! VNodes
TUPLE: vnode-monitor < monitor fd ;
: vnode-fflags ( -- n )
{
NOTE_DELETE
NOTE_WRITE
NOTE_EXTEND
NOTE_ATTRIB
NOTE_LINK
NOTE_RENAME
NOTE_REVOKE
} flags ;
: make-vnode-kevent ( fd flags -- kevent )
"kevent" <c-object>
tuck set-kevent-flags
tuck set-kevent-ident
EVFILT_VNODE over set-kevent-filter
vnode-fflags over set-kevent-fflags ;
: register-monitor ( monitor mx -- )
>r dup fd>> r>
[ >r EV_ADD EV_CLEAR bitor make-vnode-kevent r> register-kevent drop ]
[ monitors>> set-at ] 3bi ;
: unregister-monitor ( monitor mx -- )
>r fd>> r>
[ monitors>> delete-at ]
[ >r EV_DELETE make-vnode-kevent r> register-kevent ] 2bi ;
: <vnode-monitor> ( path mailbox -- monitor )
>r [ O_RDONLY 0 open dup io-error ] keep r>
vnode-monitor construct-monitor swap >>fd
[ dup kqueue-mx get register-monitor ] [ ] [ fd>> close ] cleanup ;
M: vnode-monitor dispose
[ kqueue-mx get unregister-monitor ] [ fd>> close ] bi ;

View File

@ -55,9 +55,6 @@ M: linux-monitor dispose ( monitor -- )
[ wd>> watches get delete-at ]
[ wd>> inotify-fd swap inotify_rm_watch io-error ] bi ;
: ?flag ( n mask symbol -- n )
pick rot bitand 0 > [ , ] [ drop ] if ;
: ignore-flags? ( mask -- ? )
{
IN_DELETE_SELF
@ -76,7 +73,7 @@ M: linux-monitor dispose ( monitor -- )
IN_MOVED_FROM +rename-file-old+ ?flag
IN_MOVED_TO +rename-file-new+ ?flag
drop
] { } make ;
] { } make prune ;
: parse-file-notify ( buffer -- path changed )
dup inotify-event-mask ignore-flags? [