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 libc math math.bitwise
   7 sets alien alien.strings alien.c-types vocabs.loader accessors
   8 system hashtables destructors unix classes.struct literals ;
   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     [ [ absolute-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)
  48     swap [
  49         <recursive-monitor>
  50     ] [
  51         check-inotify
  52         IN_CHANGE_EVENTS swap add-watch
  53     ] if ;
  54
  55 M: linux-monitor dispose*
  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     ]
  63     [ call-next-method ]
  64     tri ;
  65
  66 : ignore-flags? ( mask -- ? )
  67     flags{
  68         IN_DELETE_SELF
  69         IN_MOVE_SELF
  70         IN_UNMOUNT
  71         IN_Q_OVERFLOW
  72         IN_IGNORED
  73     } 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 members ;
  85
  86 : parse-event-name ( event -- name )
  87     dup len>> zero?
  88     [ drop "" ] [ name>> utf8 alien>string ] if ;
  89
  90 : parse-file-notify ( buffer -- path changed )
  91     dup mask>> ignore-flags? [
  92         drop f f
  93     ] [
  94         [ parse-event-name ] [ mask>> parse-action ] bi
  95     ] if ;
  96
  97 : events-exhausted? ( i buffer -- ? )
  98     fill>> >= ;
  99
 100 : inotify-event@ ( i buffer -- inotify-event )
 101     ptr>> <displaced-alien> inotify-event memory>struct ;
 102
 103 : next-event ( i buffer -- i buffer )
 104     2dup inotify-event@
 105     len>> inotify-event heap-size +
 106     swap [ + ] dip ;
 107
 108 : parse-file-notifications ( i buffer -- )
 109     2dup events-exhausted? [ 2drop ] [
 110         2dup inotify-event@ dup wd>> wd>monitor
 111         [ parse-file-notify ] dip queue-change
 112         next-event parse-file-notifications
 113     ] if ;
 114
 115 : inotify-read-loop ( port -- )
 116     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 namespaces:set
 127     <inotify> [
 128         [ inotify namespaces: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 ;