basis/io/monitors/windows/windows.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 alien.data alien.strings libc destructors
   4 locals kernel math assocs namespaces make continuations sequences
   5 hashtables sorting arrays combinators math.bitwise strings
   6 system accessors threads splitting io.backend
   7 io.files.windows io.monitors io.ports
   8 io.buffers io.files io.timeouts io.encodings.string literals
   9 io.encodings.utf16n io windows.errors windows.kernel32 windows.types
  10 io.pathnames classes.struct ;
  11 IN: io.monitors.windows
  12
  13 : open-directory ( path -- handle )
  14     normalize-path
  15     FILE_LIST_DIRECTORY
  16     share-mode
  17     f
  18     OPEN_EXISTING
  19     flags{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED }
  20     f
  21     CreateFile opened-file ;
  22
  23 TUPLE: win32-monitor-port < input-port recursive ;
  24
  25 TUPLE: win32-monitor < monitor port ;
  26
  27 : begin-reading-changes ( port -- overlapped )
  28     {
  29         [ handle>> handle>> ]
  30         [ buffer>> ptr>> ]
  31         [ buffer>> size>> ]
  32         [ recursive>> 1 0 ? ]
  33     } cleave
  34     FILE_NOTIFY_CHANGE_ALL
  35     0 DWORD <ref>
  36     (make-overlapped)
  37     [ f ReadDirectoryChangesW win32-error=0/f ] keep ;
  38
  39 : read-changes ( port -- bytes-transferred )
  40     [
  41         [ begin-reading-changes ] [ twiddle-thumbs ] bi
  42     ] with-destructors ;
  43
  44 : parse-action ( action -- changed )
  45     {
  46         { FILE_ACTION_ADDED [ +add-file+ ] }
  47         { FILE_ACTION_REMOVED [ +remove-file+ ] }
  48         { FILE_ACTION_MODIFIED [ +modify-file+ ] }
  49         { FILE_ACTION_RENAMED_OLD_NAME [ +rename-file+ ] }
  50         { FILE_ACTION_RENAMED_NEW_NAME [ +rename-file+ ] }
  51         [ drop +modify-file+ ]
  52     } case 1array ;
  53
  54 : memory>u16-string ( alien len -- string )
  55     memory>byte-array utf16n decode ;
  56
  57 ! Files on an NTFS downloaded from the internet may contain an
  58 ! ADS (alternate data stream) such as foo.txt:Zone.Identifier
  59 ! which the win32 API reports as the filename. We wish to strip this off
  60 ! and instead work on the actual file contents instead of ADS data.
  61 : parse-notify-record ( buffer -- path changed )
  62     [
  63         [ FileName>> ] [ FileNameLength>> ] bi
  64         memory>u16-string ":Zone.Identifier" ?tail drop
  65     ] [ Action>> parse-action ] bi ;
  66
  67 : (file-notify-records) ( buffer -- buffer )
  68     FILE_NOTIFY_INFORMATION memory>struct
  69     dup ,
  70     dup NextEntryOffset>> zero? [
  71         [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
  72         (file-notify-records)
  73     ] unless ;
  74
  75 : file-notify-records ( buffer -- seq )
  76     [ (file-notify-records) drop ] { } make ;
  77
  78 :: parse-notify-records ( monitor buffer -- )
  79     buffer file-notify-records [
  80         parse-notify-record
  81         [ monitor path>> prepend-path normalize-path ] dip
  82         monitor queue-change
  83     ] each ;
  84
  85 : fill-queue ( monitor -- )
  86     dup port>> check-disposed
  87     [ buffer>> ptr>> ] [ read-changes zero? ] bi
  88     [ 2dup parse-notify-records ] unless
  89     2drop ;
  90
  91 : (fill-queue-thread) ( monitor -- )
  92     dup fill-queue (fill-queue-thread) ;
  93
  94 : fill-queue-thread ( monitor -- )
  95     [ dup fill-queue (fill-queue-thread) ]
  96     [ dup already-disposed? [ 2drop ] [ rethrow ] if ] recover ;
  97
  98 M:: windows (monitor) ( path recursive? mailbox -- monitor )
  99     [
 100         path normalize-path mailbox win32-monitor new-monitor
 101             path open-directory \ win32-monitor-port <buffered-port>
 102                 recursive? >>recursive
 103             >>port
 104         dup [ fill-queue-thread ] curry
 105         "Windows monitor thread" spawn drop
 106     ] with-destructors ;
 107
 108 M: win32-monitor dispose
 109     [ port>> dispose ] [ call-next-method ] bi ;