basis/io/monitors/linux/linux.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.pathnames io.buffers io.ports io.timeouts
   5 io.backend.unix io.encodings.utf8 unix.linux.inotify assocs
   6 namespaces make threads continuations init math math.bitwise
   7 sets alien alien.strings alien.c-types vocabs.loader accessors
   8 system hashtables destructors unix ;
   9 IN: io.monitors.linux
  10
  11 SYMBOL: watches
  12
  13 SYMBOL: inotify
  14
  15 TUPLE: linux-monitor < monitor wd inotify watches ;
  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     [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip
  40     <linux-monitor> [ ] [ ] [ wd>> ] tri watches get set-at ;
  41
  42 : check-inotify ( -- )
  43     inotify get [
  44         "Calling <monitor> outside with-monitors" throw
  45     ] unless ;
  46
  47 M: linux (monitor) ( path recursive? mailbox -- monitor )
  48     swap [
  49         <recursive-monitor>
  50     ] [
  51         check-inotify
  52         IN_CHANGE_EVENTS swap add-watch
  53     ] if ;
  54
  55 M: linux-monitor dispose* ( monitor -- )
  56     [ [ wd>> ] [ watches>> ] bi delete-at ]
  57     [
  58         dup inotify>> disposed>> [ drop ] [
  59             [ inotify>> handle>> handle-fd ] [ wd>> ] bi
  60             inotify_rm_watch io-error
  61         ] if
  62     ] bi ;
  63
  64 : ignore-flags? ( mask -- ? )
  65     {
  66         IN_DELETE_SELF
  67         IN_MOVE_SELF
  68         IN_UNMOUNT
  69         IN_Q_OVERFLOW
  70         IN_IGNORED
  71     } flags bitand 0 > ;
  72
  73 : parse-action ( mask -- changed )
  74     [
  75         IN_CREATE +add-file+ ?flag
  76         IN_DELETE +remove-file+ ?flag
  77         IN_MODIFY +modify-file+ ?flag
  78         IN_ATTRIB +modify-file+ ?flag
  79         IN_MOVED_FROM +rename-file-old+ ?flag
  80         IN_MOVED_TO +rename-file-new+ ?flag
  81         drop
  82     ] { } make prune ;
  83
  84 : parse-event-name ( event -- name )
  85     dup inotify-event-len zero?
  86     [ drop "" ] [ inotify-event-name utf8 alien>string ] if ;
  87
  88 : parse-file-notify ( buffer -- path changed )
  89     dup inotify-event-mask ignore-flags? [
  90         drop f f
  91     ] [
  92         [ parse-event-name ] [ inotify-event-mask parse-action ] bi
  93     ] if ;
  94
  95 : events-exhausted? ( i buffer -- ? )
  96     fill>> >= ;
  97
  98 : inotify-event@ ( i buffer -- alien )
  99     ptr>> <displaced-alien> ;
 100
 101 : next-event ( i buffer -- i buffer )
 102     2dup inotify-event@
 103     inotify-event-len "inotify-event" heap-size +
 104     swap [ + ] dip ;
 105
 106 : parse-file-notifications ( i buffer -- )
 107     2dup events-exhausted? [ 2drop ] [
 108         2dup inotify-event@ dup inotify-event-wd wd>monitor
 109         [ parse-file-notify ] dip queue-change
 110         next-event parse-file-notifications
 111     ] if ;
 112
 113 : inotify-read-loop ( port -- )
 114     dup check-disposed
 115     dup wait-to-read drop
 116     0 over buffer>> parse-file-notifications
 117     0 over buffer>> buffer-reset
 118     inotify-read-loop ;
 119
 120 : inotify-read-thread ( port -- )
 121     [ inotify-read-loop ] curry ignore-errors ;
 122
 123 M: linux init-monitors
 124     H{ } clone watches set
 125     <inotify> [
 126         [ inotify set ]
 127         [
 128             [ inotify-read-thread ] curry
 129             "Linux monitor thread" spawn drop
 130         ] bi
 131     ] [
 132         "Linux kernel version is too old" throw
 133     ] if* ;
 134
 135 M: linux dispose-monitors
 136     inotify get dispose ;