basis/io/unix/linux/monitors/monitors.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel io.backend io.monitors io.monitors.recursive
   4 io.files io.buffers io.monitors io.ports io.timeouts
   5 io.unix.backend io.unix.select io.encodings.utf8
   6 unix.linux.inotify assocs namespaces threads continuations init
   7 math math.bitfields sets alien alien.strings alien.c-types
   8 vocabs.loader accessors system hashtables destructors unix ;
   9 IN: io.unix.linux.monitors
  10
  11 SYMBOL: watches
  12
  13 SYMBOL: inotify
  14
  15 TUPLE: linux-monitor < monitor wd inotify watches disposed ;
  16
  17 : <linux-monitor> ( wd path mailbox -- monitor )
  18     linux-monitor new-monitor
  19         inotify get >>inotify
  20         watches get >>watches
  21         swap >>wd ;
  22
  23 : wd>monitor ( wd -- monitor ) watches get at ;
  24
  25 : <inotify> ( -- port/f )
  26     inotify_init dup 0 < [ drop f ] [ <fd> init-fd <input-port> ] if ;
  27
  28 : inotify-fd ( -- fd ) inotify get handle>> handle-fd ;
  29
  30 : check-existing ( wd -- )
  31     watches get key? [
  32         "Cannot open multiple monitors for the same file" throw
  33     ] when ;
  34
  35 : (add-watch) ( path mask -- wd )
  36     inotify-fd -rot inotify_add_watch dup io-error dup check-existing ;
  37
  38 : add-watch ( path mask mailbox -- monitor )
  39     >r
  40     >r (normalize-path) r>
  41     [ (add-watch) ] [ drop ] 2bi r>
  42     <linux-monitor> [ ] [ ] [ wd>> ] tri watches get set-at ;
  43
  44 : check-inotify ( -- )
  45     inotify get [
  46         "Calling <monitor> outside with-monitors" throw
  47     ] unless ;
  48
  49 M: linux (monitor) ( path recursive? mailbox -- monitor )
  50     swap [
  51         <recursive-monitor>
  52     ] [
  53         check-inotify
  54         IN_CHANGE_EVENTS swap add-watch
  55     ] if ;
  56
  57 M: linux-monitor dispose* ( monitor -- )
  58     [ [ wd>> ] [ watches>> ] bi delete-at ]
  59     [
  60         dup inotify>> disposed>> [ drop ] [
  61             [ inotify>> handle>> handle-fd ] [ wd>> ] bi
  62             inotify_rm_watch io-error
  63         ] if
  64     ] bi ;
  65
  66 : ignore-flags? ( mask -- ? )
  67     {
  68         IN_DELETE_SELF
  69         IN_MOVE_SELF
  70         IN_UNMOUNT
  71         IN_Q_OVERFLOW
  72         IN_IGNORED
  73     } flags bitand 0 > ;
  74
  75 : parse-action ( mask -- changed )
  76     [
  77         IN_CREATE +add-file+ ?flag
  78         IN_DELETE +remove-file+ ?flag
  79         IN_MODIFY +modify-file+ ?flag
  80         IN_ATTRIB +modify-file+ ?flag
  81         IN_MOVED_FROM +rename-file-old+ ?flag
  82         IN_MOVED_TO +rename-file-new+ ?flag
  83         drop
  84     ] { } make prune ;
  85
  86 : parse-event-name ( event -- name )
  87     dup inotify-event-len zero?
  88     [ drop "" ] [ inotify-event-name utf8 alien>string ] if ;
  89
  90 : parse-file-notify ( buffer -- path changed )
  91     dup inotify-event-mask ignore-flags? [
  92         drop f f
  93     ] [
  94         [ parse-event-name ] [ inotify-event-mask parse-action ] bi
  95     ] if ;
  96
  97 : events-exhausted? ( i buffer -- ? )
  98     fill>> >= ;
  99
 100 : inotify-event@ ( i buffer -- alien )
 101     ptr>> <displaced-alien> ;
 102
 103 : next-event ( i buffer -- i buffer )
 104     2dup inotify-event@
 105     inotify-event-len "inotify-event" heap-size +
 106     swap >r + r> ;
 107
 108 : parse-file-notifications ( i buffer -- )
 109     2dup events-exhausted? [ 2drop ] [
 110         2dup inotify-event@ dup inotify-event-wd wd>monitor
 111         >r parse-file-notify r> queue-change
 112         next-event parse-file-notifications
 113     ] if ;
 114
 115 : inotify-read-loop ( port -- )
 116     dup check-disposed
 117     dup wait-to-read drop
 118     0 over buffer>> parse-file-notifications
 119     0 over buffer>> buffer-reset
 120     inotify-read-loop ;
 121
 122 : inotify-read-thread ( port -- )
 123     [ inotify-read-loop ] curry ignore-errors ;
 124
 125 M: linux init-monitors
 126     H{ } clone watches set
 127     <inotify> [
 128         [ inotify set ]
 129         [
 130             [ inotify-read-thread ] curry
 131             "Linux monitor thread" spawn drop
 132         ] bi
 133     ] [
 134         "Linux kernel version is too old" throw
 135     ] if* ;
 136
 137 M: linux dispose-monitors
 138     inotify get dispose ;