blob: 76d0bb21534a223cf1c5212098615b321cb24f13 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#!/usr/bin/env tclsh
## -*- tcl -*-
package require Tcl 8.5
package require fileutil
package require sha1
# This application stores received nntp messages into a named directory.
# That name is specified on the command line.
# The article is read from stdin.
#
# The application supports the API expected by 'pullnews' for saving
# and id handling.
# Signature (syntax) of the storage command:
#
# (1) <cmd> last => Returns last id processed.
# (2) <cmd> save <id> => Take message through stdin, and save, mark <id> as last.
proc main {} {
if {![cmdline]} usage
$::method
}
proc cmdline {} {
global argv directory method saveid
if {[llength $argv] < 2} {return 0}
# Retrieve arguments
lassign $argv directory method
if {$method eq "save"} {
if {[llength $argv] != 3} {return 0}
set saveid [lindex $argv 2]
} else {
if {[llength $argv] != 2} {return 0}
}
validatedir store $directory
return 1
}
proc validatedir {which path} {
if {![file exists $path]} { stop "$which does not exist: $path" }
if {![file isdirectory $path]} { stop "$which not a file: $path" }
if {![file readable $path]} { stop "$which not readable: $path" }
if {![file writable $path]} { stop "$which not writable: $path" }
}
proc usage {} {
global argv0
puts stderr "$argv0: wrong # args, should be \"$argv0 last|(save <id>)\""
exit 1
}
proc stop {text} {
global argv0
puts stderr "$argv0: $text"
exit 1
}
proc last {} {
global directory
if {![file exists $directory/last]} {
set id {}
} else {
set id [string trim [fileutil::cat $directory/last]]
}
puts $id
return
}
proc save {} {
global directory saveid
set dst [open $directory/current w]
fcopy stdin $dst
close $dst
file rename -force $directory/current $directory/q$saveid
fileutil::writeFile $directory/last $saveid
return
}
main
exit
|
