2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: kernel io.backend io.monitors io.monitors.recursive
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-16 11:50:16 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								io.files io.pathnames io.buffers io.ports io.timeouts
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.backend.unix io.encodings.utf8 unix.linux.inotify assocs
							 | 
						
					
						
							
								
									
										
										
										
											2013-10-21 16:58:33 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								namespaces make threads continuations init libc math math.bitwise
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-11 23:48:19 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								sets alien alien.strings alien.c-types vocabs.loader accessors
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								system hashtables destructors unix classes.struct literals ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 21:03:00 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: io.monitors.linux
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-21 07:13:57 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: watches
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: inotify
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-08-24 03:26:13 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: linux-monitor < monitor wd inotify watches ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <linux-monitor> ( wd path mailbox -- monitor )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-14 06:07:31 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    linux-monitor new-monitor
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-21 07:13:57 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        inotify get >>inotify
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        watches get >>watches
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        swap >>wd ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: wd>monitor ( wd -- monitor ) watches get at ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <inotify> ( -- port/f )
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-03 18:44:44 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    inotify_init dup 0 < [ drop f ] [ <fd> init-fd <input-port> ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 14:43:31 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: inotify-fd ( -- fd ) inotify get handle>> handle-fd ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: check-existing ( wd -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    watches get key? [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "Cannot open multiple monitors for the same file" throw
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] when ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: (add-watch) ( path mask -- wd )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    inotify-fd -rot inotify_add_watch dup io-error dup check-existing ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: add-watch ( path mask mailbox -- monitor )
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-28 18:25:50 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ absolute-path ] dip [ (add-watch) ] [ drop ] 2bi ] dip
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <linux-monitor> [ ] [ ] [ wd>> ] tri watches get set-at ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-09 14:43:31 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: check-inotify ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    inotify get [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "Calling <monitor> outside with-monitors" throw
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] unless ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: linux (monitor) ( path recursive? mailbox -- monitor )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <recursive-monitor>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        check-inotify
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_CHANGE_EVENTS swap add-watch
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 00:23:12 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: linux-monitor dispose* ( monitor -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ wd>> ] [ watches>> ] bi delete-at ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2010-08-24 23:01:37 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        dup inotify>> disposed>> [ drop ] [
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-16 02:44:52 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ inotify>> handle>> handle-fd ] [ wd>> ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            inotify_rm_watch io-error
							 | 
						
					
						
							
								
									
										
										
										
											2010-08-24 23:01:37 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        ] if
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-19 06:23:24 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ call-next-method ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    tri ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: ignore-flags? ( mask -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    flags{
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_DELETE_SELF
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_MOVE_SELF
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_UNMOUNT
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_Q_OVERFLOW
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_IGNORED
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 15:43:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    } bitand 0 > ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-action ( mask -- changed )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_CREATE +add-file+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_DELETE +remove-file+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_MODIFY +modify-file+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_ATTRIB +modify-file+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_MOVED_FROM +rename-file-old+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        IN_MOVED_TO +rename-file-new+ ?flag
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        drop
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-27 13:14:03 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] { } make members ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-27 22:34:18 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-event-name ( event -- name )
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup len>> zero?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ drop "" ] [ name>> utf8 alien>string ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-06-27 22:34:18 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-file-notify ( buffer -- path changed )
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup mask>> ignore-flags? [
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        drop f f
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] [
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ parse-event-name ] [ mask>> parse-action ] bi
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: events-exhausted? ( i buffer -- ? )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    fill>> >= ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: inotify-event@ ( i buffer -- inotify-event )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ptr>> <displaced-alien> inotify-event memory>struct ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: next-event ( i buffer -- i buffer )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2dup inotify-event@
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    len>> inotify-event heap-size +
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-02 04:10:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap [ + ] dip ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-file-notifications ( i buffer -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2dup events-exhausted? [ 2drop ] [
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-08 15:15:25 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        2dup inotify-event@ dup wd>> wd>monitor
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-02 04:10:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ parse-file-notify ] dip queue-change
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        next-event parse-file-notifications
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: inotify-read-loop ( port -- )
							 | 
						
					
						
							
								
									
										
										
										
											2014-11-21 11:19:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    check-disposed
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-18 20:02:50 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup wait-to-read drop
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 15:09:09 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    0 over buffer>> parse-file-notifications
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    0 over buffer>> buffer-reset
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    inotify-read-loop ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: inotify-read-thread ( port -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ inotify-read-loop ] curry ignore-errors ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: linux init-monitors
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-29 21:27:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    H{ } clone watches namespaces:set
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    <inotify> [
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-29 21:27:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ inotify namespaces:set ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-11 08:15:26 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ inotify-read-thread ] curry
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            "Linux monitor thread" spawn drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] bi
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "Linux kernel version is too old" throw
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if* ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: linux dispose-monitors
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    inotify get dispose ;
							 |