Implement monitors for BSD
parent
82d793b141
commit
d132bce5a3
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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? [
|
||||
|
|
Loading…
Reference in New Issue