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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
########### msgdata.tcl
# Routines (part of main program) for dealing with SAUCEADMIN.
#
# This file is part of SAUCE, a very picky anti-spam receiver-SMTP.
# SAUCE is Copyright (C) 1997-2003 Ian Jackson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# $Id: yesmaster.tcl,v 1.16 2003/06/15 15:46:40 ian Exp $
# state variables used during tcl commands processing:
# sofar partially received command
set yesmaster_shutdowns {}
thread_chainproc ic yesmaster_outdone {} {
ic_yesmaster_startcmd
}
thread_subproc ic yesmaster_startcmd {} {
set state(sofar) {}
threadio_putsgets ic $id $state(chan) "% " yesmaster_gotdata yesmaster_err
}
thread_chainproc ic yesmaster_gotdata {data} {
global errorInfo yesmaster_shutdowns threads
if {![string length $data] && [eof $state(chan)]} {
thread_finish ic $id
return
}
append state(sofar) $data
if {"$state(sofar)" == ";"} {
set state(sofar) {}
threadio_putsgets ic $id $state(chan) "\nEOP\n" yesmaster_gotdata yestmaster_err
return
}
if {"[string trim $state(sofar)]" == "shutdown"} {
unset threads([list ic $id])
shutdown
} elseif {[info complete $state(sofar)]} {
set code [catch [list uplevel #0 $state(sofar)] result]
if {$code} {
set output "** $errorInfo\n"
} elseif {[string length $result]} {
set output "=> $result\n"
} else {
set output {}
}
threadio_puts ic $id $state(chan) $output yesmaster_outdone yesmaster_err
} else {
threadio_gets ic $id $state(chan) yesmaster_gotdata yesmaster_err
}
}
thread_chainproc ic yesmaster_err {emsg} {
log notice "$state(desc): error during admin: $emsg"
thread_finish ic $id
}
########## adminsecret thread
#
# thread_start adminsecret $desc
#
# never returns
# state variables:
# toid timeout id
thread_typedefine adminsecret {} {
adminsecret_refresh
} NO-CLEAN-SHUTDOWN {
global adminsecret
set adminsecret {}
catch { after cancel $state(toid) }
}
thread_chainproc adminsecret timeout {} {
adminsecret_refresh
}
thread_subproc adminsecret refresh {} {
global adminsecret admin_secret_length admin_secret_refresh var_dir
set adminsecret {}
set chan {}
if {[catch {
set new [exec -keepnewline dd if=/dev/urandom bs=1 \
count=[format %d $admin_secret_length] 2>/dev/null]
if {[string length $new] == $admin_secret_length} {
if {[file exists $var_dir/adminsecret] &&
[file size $var_dir/adminsecret] <= $admin_secret_length} {
set mode {WRONLY CREAT}
} else {
set mode w
}
set chan [open $var_dir/adminsecret $mode 0600]
puts -nonewline $chan $new
close $chan
unset chan
set adminsecret $new
log notice "new admin secret set"
} else {
error "admin secret wrong length"
}
} emsg]} {
log error "unable to make new admin secret: $emsg"
}
thread_after adminsecret $id $admin_secret_refresh timeout
}
########## helper and command functions for sauceadmin
#
proc show {args} {
return [join $args]
}
proc help {} {
show {Some useful commands:
readconfig reread config files
reopenlogs reopen log files
show <value> like puts, but goes where you want it
exit stop SAUCE immediately
set debug_level <number> set debugging level
set <config_var> <canon> reconfigure - but be careful, no checking !
userblacklist <force> <reason> addr|site <entry>}
}
proc ? {} { help }
proc userblacklist {type newst entry force why} {
set st [ds_get $type-list $entry]
if {"$newst" == "unknown"} {
set newst whitesoon
set to -1
} else {
upvar #0 ${type}_blacklist_timeout to
}
switch -exact -- $st {
whitesoon - black - verified {
}
default {
if {!$force} {
return "$type state is $st: $entry"
}
}
}
setstate $type $entry $why $newst $to
return "$type ${newst}listed: $entry"
}
|
