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