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