|
1 # |
|
2 # Copyright 2004-2006 Intel Corporation |
|
3 # |
|
4 # Licensed under the Apache License, Version 2.0 (the "License"); |
|
5 # you may not use this file except in compliance with the License. |
|
6 # You may obtain a copy of the License at |
|
7 # |
|
8 # http://www.apache.org/licenses/LICENSE-2.0 |
|
9 # |
|
10 # Unless required by applicable law or agreed to in writing, software |
|
11 # distributed under the License is distributed on an "AS IS" BASIS, |
|
12 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
|
13 # See the License for the specific language governing permissions and |
|
14 # limitations under the License. |
|
15 # |
|
16 |
|
17 # |
|
18 # Simple test code that scans a directory for new data and injects |
|
19 # whatever it finds as a bundle. |
|
20 # |
|
21 |
|
22 # |
|
23 # Starts up a file injector to scan the given directory and create |
|
24 # new bundles from any files that are found. |
|
25 # |
|
26 # usage: file_injector <dir> <source> <dest> <-period ms> |
|
27 # |
|
28 proc file_injector_start {dir source dest args} { |
|
29 global file_injector_handles |
|
30 |
|
31 set period 1000 |
|
32 |
|
33 if {$args != {}} { |
|
34 error "XXX/demmer implement optional args" |
|
35 } |
|
36 |
|
37 set after_handle [after 0 \ |
|
38 [list file_injector_scan $dir $source $dest $period]] |
|
39 set file_injector_handles($dir) $after_handle |
|
40 |
|
41 return $dir |
|
42 } |
|
43 |
|
44 # |
|
45 # Stops a file injector on the given directory |
|
46 # |
|
47 proc file_injector_stop {dir} { |
|
48 global file_injector_handles |
|
49 |
|
50 if [info exists file_injector_handles($dir)] { |
|
51 after cancel $file_injector_handles($dir) |
|
52 } else { |
|
53 error "no injector running on dir $dir" |
|
54 } |
|
55 } |
|
56 |
|
57 # |
|
58 # Internal proc that actually does the scanning |
|
59 # |
|
60 proc file_injector_scan {dir source dest period} { |
|
61 global file_injector_handles |
|
62 global fd_ftplog |
|
63 |
|
64 set files [glob -nocomplain -- "$dir/*"] |
|
65 |
|
66 # log /file_injector DEBUG "scanning $dir... found [llength $files] files" |
|
67 foreach file $files { |
|
68 file stat $file file_stat |
|
69 |
|
70 log /file_injector DEBUG "stat type $file_stat(type)" |
|
71 |
|
72 if {$file_stat(type) != "file"} { |
|
73 log /file_injector DEBUG \ |
|
74 "ignoring file $file type $file_stat(type)" |
|
75 continue |
|
76 } |
|
77 |
|
78 set len $file_stat(size) |
|
79 if {$len == 0} { |
|
80 log /file_injector DEBUG "ignoring empty file $file" |
|
81 continue |
|
82 } |
|
83 |
|
84 log /file_injector DEBUG "reading payload from bundle file $file"; |
|
85 set fd [open $file] |
|
86 fconfigure $fd -translation binary |
|
87 set payload [read $fd] |
|
88 close $fd |
|
89 |
|
90 log /file_injector DEBUG "gotnow $len byte payload" |
|
91 |
|
92 log /file_injector INFO " sending bundle [file tail $file] $len byte payload" |
|
93 |
|
94 if {[info exists fd_ftplog]} { |
|
95 puts $fd_ftplog "[time] :: sending bundle [file tail $file] $len byte " |
|
96 flush $fd_ftplog |
|
97 |
|
98 } |
|
99 bundle inject $source "$dest/[file tail $file]" $payload option [list length $len] |
|
100 |
|
101 file delete $file |
|
102 } |
|
103 |
|
104 # re-schedule the scan |
|
105 set after_handle [after $period \ |
|
106 [list file_injector_scan $dir $source $dest $period]] |
|
107 set file_injector_handles($dir) $after_handle |
|
108 return "" |
|
109 } |