basis/io/windows/nt/monitors/monitors.factor

   1 ! Copyright (C) 2008 Doug Coleman, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien alien.c-types libc destructors locals
   4 kernel math assocs namespaces continuations sequences hashtables
   5 sorting arrays combinators math.bitwise strings system
   6 accessors threads splitting
   7 io.backend io.windows io.windows.nt.backend io.windows.nt.files
   8 io.monitors io.ports io.buffers io.files io.timeouts io
   9 windows windows.kernel32 windows.types ;
  10 IN: io.windows.nt.monitors
  11
  12 : open-directory ( path -- handle )
  13     normalize-path
  14     FILE_LIST_DIRECTORY
  15     share-mode
  16     f
  17     OPEN_EXISTING
  18     { FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } flags
  19     f
  20     CreateFile opened-file ;
  21
  22 TUPLE: win32-monitor-port < input-port recursive ;
  23
  24 TUPLE: win32-monitor < monitor port ;
  25
  26 : begin-reading-changes ( port -- overlapped )
  27     {
  28         [ handle>> handle>> ]
  29         [ buffer>> ptr>> ]
  30         [ buffer>> size>> ]
  31         [ recursive>> 1 0 ? ]
  32     } cleave
  33     FILE_NOTIFY_CHANGE_ALL
  34     0 <uint>
  35     (make-overlapped)
  36     [ f ReadDirectoryChangesW win32-error=0/f ] keep ;
  37
  38 : read-changes ( port -- bytes-transferred )
  39     [
  40         [ begin-reading-changes ] [ twiddle-thumbs ] bi
  41     ] with-destructors ;
  42
  43 : parse-action ( action -- changed )
  44     {
  45         { FILE_ACTION_ADDED [ +add-file+ ] }
  46         { FILE_ACTION_REMOVED [ +remove-file+ ] }
  47         { FILE_ACTION_MODIFIED [ +modify-file+ ] }
  48         { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
  49         { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
  50         [ drop +modify-file+ ]
  51     } case 1array ;
  52
  53 : memory>u16-string ( alien len -- string )
  54     [ memory>byte-array ] keep 2/ c-ushort-array> >string ;
  55
  56 : parse-notify-record ( buffer -- path changed )
  57     [
  58         [ FILE_NOTIFY_INFORMATION-FileName ]
  59         [ FILE_NOTIFY_INFORMATION-FileNameLength ]
  60         bi memory>u16-string
  61     ]
  62     [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
  63
  64 : (file-notify-records) ( buffer -- buffer )
  65     dup ,
  66     dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
  67         [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
  68         (file-notify-records)
  69     ] unless ;
  70
  71 : file-notify-records ( buffer -- seq )
  72     [ (file-notify-records) drop ] { } make ;
  73
  74 :: parse-notify-records ( monitor buffer -- )
  75     buffer file-notify-records [
  76         parse-notify-record
  77         [ monitor path>> prepend-path normalize-path ] dip
  78         monitor queue-change
  79     ] each ;
  80
  81 : fill-queue ( monitor -- )
  82     dup port>> dup check-disposed
  83     [ buffer>> ptr>> ] [ read-changes zero? ] bi
  84     [ 2dup parse-notify-records ] unless
  85     2drop ;
  86
  87 : (fill-queue-thread) ( monitor -- )
  88     dup fill-queue (fill-queue-thread) ;
  89
  90 : fill-queue-thread ( monitor -- )
  91     [ dup fill-queue (fill-queue-thread) ]
  92     [ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ;
  93
  94 M:: winnt (monitor) ( path recursive? mailbox -- monitor )
  95     [
  96         path normalize-path mailbox win32-monitor new-monitor
  97             path open-directory \ win32-monitor-port <buffered-port>
  98                 recursive? >>recursive
  99             >>port
 100         dup [ fill-queue-thread ] curry
 101         "Windows monitor thread" spawn drop
 102     ] with-destructors ;
 103
 104 M: win32-monitor dispose
 105     port>> dispose ;