Use new module in top-level CGIs
[webmin.git] / feedback.cgi
1 #!/usr/local/bin/perl
2 # Send the webmin feedback form
3
4 BEGIN { push(@INC, ".."); };
5 use WebminCore;
6
7 &init_config();
8 &ReadParseMime();
9 &error_setup($text{'feedback_err'});
10 %access = &get_module_acl();
11 $access{'feedback'} || &error($text{'feedback_ecannot'});
12
13 # Construct the email body
14 $in{'text'} =~ s/\r//g;
15 $date = localtime(time());
16 $ver = &get_webmin_version();
17 if ($in{'name'} && $in{'email'}) {
18         $from = "$in{'name'} <$in{'email'}>";
19         $email = $in{'email'};
20         }
21 elsif ($in{'email'}) {
22         $email = $from = $in{'email'};
23         }
24 else {
25         $email = $from = "feedback\@".&get_system_hostname();
26         }
27 local $m = $in{'module'};
28 $m || !$in{'config'} || &error($text{'feedback_emodule'});
29 &check_os_support($m) && $m !~ /\.\./ || &error($text{'feedback_emodule2'});
30 if ($m) {
31         %minfo = &get_module_info($m);
32         $ver .= " (Module: $minfo{'version'})" if ($minfo{'version'});
33         $module = "$m ($minfo{'desc'})";
34         }
35 else {
36         $module = "None";
37         }
38 if ($gconfig{'nofeedbackcc'}) {
39         @tolist = ( $gconfig{'feedback_to'} ||
40                     $minfo{'feedback'} ||
41                     $webmin_feedback_address );
42         }
43 else {
44         @tolist = split(/\s+/, $in{'to'});
45         }
46 @tolist || &error($text{'feedback_enoto'});
47 foreach $t (@tolist) {
48         $headers .= "To: $t\n";
49         }
50 $headers .= "From: $from\n";
51 $headers .= "Subject: $text{'feedback_title'}\n";
52
53 $attach[0] = <<EOF;
54 Content-Type: text/plain
55 Content-Transfer-Encoding: 7bit
56
57 Name:           $in{'name'}
58 Email address:  $in{'email'}
59 Date:           $date
60 Webmin version: $ver
61 Perl version:   $]
62 Module:         $module
63 Browser:        $ENV{'HTTP_USER_AGENT'}
64 EOF
65
66 if ($in{'os'}) {
67         $uname = `uname -a`;
68         $attach[0] .= <<EOF;
69 OS from webmin: $gconfig{'real_os_type'} $gconfig{'real_os_version'}
70 OS code:        $gconfig{'os_type'} $gconfig{'os_version'}
71 Uname output:   $uname
72 EOF
73         }
74
75 $attach[0] .= "\n".$in{'text'}."\n";
76
77 if ($in{'config'} && !$gconfig{'nofeedbackconfig'}) {
78         # Check if this user has full rights to the module
79         $access{'feedback'} >= 2 || &error($text{'feedback_ecannot2'});
80         local %uacl = &get_module_acl(undef, $m);
81         local %defacl;
82         local $mdir = &module_root_directory($m);
83         &read_file("$mdir/defaultacl", \%defacl);
84         if ($access{'feedback'} != 3) {
85                 foreach $k (keys %uacl) {
86                         if ($defacl{$k} ne $uacl{$k}) {
87                                 &error($text{'feedback_econfig'});
88                                 }
89                         }
90                 }
91
92         # Attach all the text file from the module's config
93         local %mconfig = &foreign_config($m);
94         if (keys %mconfig) {
95                 local $a;
96                 $a .= "Content-Type: text/plain; name=\"config\"\n";
97                 $a .= "Content-Transfer-Encoding: 7bit\n";
98                 $a .= "\n";
99                 foreach $k (keys %mconfig) {
100                         $a .= "$k=$mconfig{$k}\n";
101                         }
102                 push(@attach, $a);
103                 }
104
105         # Find out what config files the module uses
106         local @files;
107         if (-r "$mdir/feedback_files.pl") {
108                 # Ask the module for it's files
109                 &foreign_require($m, "feedback_files.pl");
110                 @files = &foreign_call($m, "feedback_files", $m);
111                 }
112
113         # Use all the path in the config
114         foreach $k (keys %mconfig) {
115                 push(@files, $mconfig{$k}) if ($mconfig{$k} =~ /^\//);
116                 }
117         @files = &unique(@files);
118
119         # Attach those config files that are plain text (less than 5%
120         # non-ascii characters). Also skip logfiles.
121         foreach $f (@files) {
122                 next if (!$f || -d $f);
123                 next if ($f =~ /\/var\/log\//);
124                 local $/ = undef;
125                 open(FILE, $f) || next;
126                 local $data = <FILE>;
127                 close(FILE);
128                 local $count = ($data =~ tr/[\000-\176]/[\000-\176]/);
129                 if (!length($data) || 100*$count / length($data) > 95) {
130                         # File is text
131                         local $a;
132                         local $sf = &short_name($f);
133                         $a .= "Content-Type: text/plain; name=\"$sf\"\n";
134                         $a .= "Content-Transfer-Encoding: 7bit\n";
135                         $a .= "\n";
136                         $a .= $data;
137                         push(@attach, $a);
138                         }
139                 }
140         }
141
142 # Include uploaded attached files
143 foreach $u ('attach0', 'attach1') {
144         if ($in{$u} ne '') {
145                 local $a;
146                 local $name = &short_name($in{"${u}_filename"});
147                 local $type = $in{"${u}_content_type"};
148                 $type = &guess_mime_type($name) if (!$type);
149                 $a .= "Content-type: $type; name=\"$name\"\n";
150                 $a .= "Content-Transfer-Encoding: base64\n";
151                 $a .= "\n\n";
152                 $a .= &encode_base64($in{$u});
153                 push(@attach, $a);
154                 }
155         }
156
157 # Build the MIME email
158 $bound = "bound".time();
159 $mail = $headers;
160 $mail .= "Content-Type: multipart/mixed; boundary=\"$bound\"\n";
161 $mail .= "MIME-Version: 1.0\n";
162 $mail .= "\n";
163 $mail .= "This is a multi-part message in MIME format.\n";
164 foreach $a (@attach) {
165         $mail .= "\n--".$bound."\n";
166         $mail .= $a;
167         }
168 $mail .= "\n--".$bound."--\n";
169
170 if (!$in{'mailserver_def'}) {
171         $ok = &send_via_smtp($in{'mailserver'});
172         $sent = 3 if ($ok);
173         }
174
175 if (!$sent) {
176         # Try to send the email by calling sendmail -t
177         %sconfig = &foreign_config("sendmail");
178         $sendmail = $sconfig{'sendmail_path'} ? $sconfig{'sendmail_path'}
179                                               : &has_command("sendmail");
180         if (-x $sendmail && open(MAIL, "| $sendmail -t")) {
181                 print MAIL $mail;
182                 if (close(MAIL)) {
183                         $sent = 2;
184                         }
185                 }
186         }
187
188 if (!$sent) {
189         # Try to connect to a local SMTP server
190         $ok = &send_via_smtp("localhost");
191         $sent = 1 if ($ok);
192         }
193
194 if ($sent) {
195         # Tell the user that it was sent OK
196         &ui_print_header(undef, $text{'feedback_title'}, "", undef, 0, 1);
197         if ($sent == 3) {
198                 print &text('feedback_via', join(",", @tolist),
199                             "<tt>$in{'mailserver'}</tt>"),"\n";
200                 }
201         elsif ($sent == 2) {
202                 print &text('feedback_prog', join(",", @tolist),
203                             "<tt>$sendmail</tt>"),"\n";
204                 }
205         else {
206                 print &text('feedback_via', join(",", @tolist),
207                             "<tt>localhost</tt>"),"\n";
208                 }
209         print "<p>\n";
210         &ui_print_footer("/?cat=$minfo{'category'}", $text{'index'});
211
212         # Save settings in config
213         $gconfig{'feedback_name'} = $in{'name'};
214         $gconfig{'feedback_email'} = $in{'email'};
215         $gconfig{'feedback_mailserver'} =
216                 $in{'mailserver_def'} ? undef : $in{'mailserver'};
217         &write_file("$config_directory/config", \%gconfig);
218         }
219 else {
220         # Give up! Tell the user ..
221         &error($text{'feedback_esend'});
222         }
223
224 sub send_via_smtp
225 {
226 local $error;
227 &open_socket($_[0], 25, MAIL, \$error);
228 return 0 if ($error);
229 &smtp_command(MAIL) || return 0;
230 &smtp_command(MAIL, "helo ".&get_system_hostname()."\r\n") || return 0;
231 &smtp_command(MAIL, "mail from: <$email>\r\n") || return 0;
232 foreach $t (@tolist) {
233         &smtp_command(MAIL, "rcpt to: <$t>\r\n") || return 0;
234         }
235 &smtp_command(MAIL, "data\r\n");
236 $mail =~ s/\r//g;
237 $mail =~ s/\n/\r\n/g;
238 print MAIL $mail;
239 &smtp_command(MAIL, ".\r\n");
240 &smtp_command(MAIL, "quit\r\n");
241 close(MAIL);
242 return 1;
243 }
244
245 # smtp_command(handle, command)
246 sub smtp_command
247 {
248 local ($m, $c) = @_;
249 print $m $c;
250 local $r = <$m>;
251 return $r =~ /^[23]\d+/;
252 }
253
254 sub short_name
255 {
256 $_[0] =~ /([^\\\/]+)$/;
257 return $1;
258 }
259