1#!@PERL @
2
3$DEBUG = 1;
4
5use lib '@CGI_BIN@';
6require 'mlconfig-data.pl';
7
8open(CHALLENGE, "$ENV{HOME}/.mlterm/challenge");
9$challenge = <CHALLENGE>;
10close(CHALLENGE);
11
12$config_file = "$ENV{HOME}/.mlterm/main";
13$CGI = $ENV{SCRIPT_NAME} || $0;
14$CGI = &htvt_quote($CGI);
15$local_cookie = $ENV{LOCAL_COOKIE};
16$method = ($ENV { REQUEST_METHOD } eq 'POST');
17if ($method) {
18  sysread(STDIN, $query, $ENV{CONTENT_LENGTH});
19} else {
20  $query = $ENV{QUERY_STRING};
21}
22for (split('&', $query)) {
23  s / ^([^=] *) =  //;
24      $value->{
25          $1} = &form_decode($_);
26}
27if ($local_cookie ne $value->{COOKIE}) {
28  $method = 0;
29}
30if ($method) {
31  if ($value->{SAVE}) {
32    if ($value->{ SAVE } eq 'Yes') {
33      &save_config();
34    }
35    &make_header(0, $method);
36    exit;
37  }
38  if ($value->{ SUBMIT } eq 'Cancel') {
39    &make_header(1, $method);
40    exit;
41  }
42  elsif($value->{full_reset}) {
43    &set_config({full_reset = > '' });
44    &get_config();
45    &check_value();
46  }
47  else {
48    &check_value();
49    if ($value->{ SUBMIT } eq 'Save') {
50      &load_config();
51      &make_save_config();
52      exit;
53    }
54    elsif($value->{ SUBMIT } eq 'OK') {
55      &set_config();
56      &make_header(1, $method);
57      exit;
58    }
59    elsif($value->{ SUBMIT } eq 'Apply') { &set_config(); }
60    elsif($value->{fontsize_larger}) {
61      &set_config({fontsize = > 'larger'});
62      &get_config(['fontsize']);
63    }
64    elsif($value->{fontsize_smaller}) {
65      &set_config({fontsize = > 'smaller'});
66      &get_config(['fontsize']);
67    }
68  }
69} else {
70  &get_config();
71  &check_value();
72}
73
74&make_header(0, $method);
75&make_html();
76
77sub make_header {
78  local($quit, $method) = @_;
79
80  if ($value->{SAVE}) {
81    print "w3m-control: DELETE_PREVBUF\n";
82    print "w3m-control: BACK\n";
83  }
84  elsif($quit && $value->{ QUIT } ne 'no') { print "w3m-control: EXIT\n"; }
85  else {
86    if ($value->{ SUBMIT } eq 'Apply') {
87      print "w3m-control: GOTO #apply\n";
88    } else {
89      print "w3m-control: GOTO #pos\n";
90    }
91    print "w3m-control: DELETE_PREVBUF\n";
92    if ($quit || $method) {
93      print "w3m-control: DELETE_PREVBUF\n";
94    }
95  }
96  print "Content-Type: text/html\n\n";
97}
98
99sub make_html {
100  local($s);
101
102  print << EOF;
103  <html><head><title> mlterm configuration</ title></ head><body><
104      form action = "$CGI" method =
105          POST><input type = hidden name = "COOKIE" value =
106                    "$local_cookie"><input type = hidden name = "QUIT" value =
107                                         "$value->{QUIT}"><center><b> mlterm
108          configuration</ b><table border = 1 width = 200> EOF
109              $value->{SECTION} || = $value->{"default-SECTION"};
110  $value->{SECTION} = ~tr / A - Z / a - z / ;
111  if (!defined($section_attr->{$value->{SECTION}})) {
112    $value->{SECTION} = $section[0];
113  }
114  &make_section($value->{SECTION});
115  print << EOF;
116  <tr><td colspan = 2 align = center><nobr><input type = submit name =
117                                                "SUBMIT" value = "OK"> &nbsp;
118  <a name = "apply"><input type = submit name = "SUBMIT" value = "Apply"></ a> &
119      nbsp;
120  <input type = submit name = "SUBMIT" value = "Cancel"> &nbsp;
121  <input type = reset value = "Reset"> &nbsp;
122  <input type = submit name = "SUBMIT" value =
123       "Save"></ nobr><tr align = center><td width = 50 %><table><tr><td> Font
124      size<br><input type = submit name = "fontsize_larger" value = "Larger"><
125          input type = submit name = "fontsize_smaller" value =
126              "Smaller"></ table><td width = 50 %><table><tr><td> Full
127          Reset<br><input type = submit name = "full_reset" value =
128                        "Full Reset"></ table></ table></ center></ form><
129              / body></ html> EOF
130}
131
132sub make_section {
133  local($s) = @_;
134  local($attr) = $section_attr->{$s};
135  local($k, $s2);
136
137  print << EOF;
138<tr><td colspan=2 align=center><nobr>
139<input type=hidden name="default-SECTION" value="$s">
140EOF
141	for $s2 (@section) {
142  if ($s eq $s2) {
143    print "<b>[<a name=\"pos\">$section_attr->{$s}{title}</a>]</b>\n";
144  } else {
145    print "<input type=submit name=\"SECTION\"",
146        " value=\"$section_attr->{$s2}{title}\">\n";
147  }
148}
149print << EOF;
150</nobr>
151<tr><td colspan=2 align=center>
152<table>
153EOF
154	for $k (@{$attr->{key}}) {
155  &make_key($k);
156}
157print << EOF;
158</table>
159EOF
160	for $s2 (@section) {
161  $s eq $s2 &&next;
162  $attr = $section_attr->{$s2};
163                for
164                  $k(@{$attr->{key}}) {
165                    print "<input type=hidden name=\"$k\" value=\"",
166                        &htvt_quote($value->{$k}), "\">\n";
167                    print "<input type=hidden name=\"default-$k\" value=\"",
168                        &htvt_quote($value->{"default-$k"}), "\">\n";
169                  }
170}
171}
172
173sub make_key {
174  local($k) = @_;
175  local($attr) = $key_attr->{$k};
176  local($type) = $attr->{type};
177  local($i);
178
179  if (!$attr->{col}) {
180    print "<tr>";
181    if ($type = ~ / ^checkbox / || $type = ~ / ^none / ) {
182      print "<td colspan=2>\n";
183    }
184    elsif($type = ~ / ^radio / ) {
185      print "<td colspan=2><nobr>$attr->{title}\n";
186    }
187    else {
188      print "<td><nobr>$attr->{title}</nobr>\n";
189      print "<td>";
190    }
191  } else {
192    print "&nbsp;\n";
193  }
194  if ($type = ~ / ^text / ) {
195    print "<input type=text name=\"$k\" value=\"", &htvt_quote($value->{$k}),
196        "\">\n";
197  }
198  elsif($type = ~ / ^select / ) {
199    print "<select name=\"$k\">\n";
200                for
201                  $i(@{$attr->{item}}) {
202                    print "<option value=\"$i\"";
203                    if ($value->{ $k } eq "$i") {
204                      print " selected";
205                    }
206                    print ">";
207                    print "$item_attr->{$k}{$i}\n";
208                  }
209                print "</select>\n";
210  }
211  elsif($type = ~ / ^radio / ) {
212                for
213                  $i(@{$attr->{item}}) {
214                    print "&nbsp;<input type=radio name=\"$k\" value=\"$i\"";
215                    if ($value->{ $k } eq "$i") {
216                      print " checked";
217                    }
218                    print "> $item_attr->{$k}{$i}\n";
219                  }
220                print "</nobr>\n";
221  }
222  elsif($type = ~ / ^checkbox / ) {
223    print "<input type=checkbox name=\"$k\" value=\"true\"";
224    if ($value->{ $k } eq "true") {
225      print " checked";
226    }
227    print ">\n";
228    print "$attr->{title}\n";
229  }
230  elsif($type = ~ / ^none / ) {
231    print "$attr->{title}\n";
232    return;
233  }
234  print "<input type=hidden name=\"default-$k\" value=\"",
235      &htvt_quote($value->{"default-$k"}), "\">\n";
236}
237
238sub check_value {
239  local($k, $attr, $_, $ok);
240
241        for
242          $k(keys % {$key_attr}) {
243            $k = ~ / ^_ / &&next;
244            $attr = $key_attr->{$k};
245            $ok = 1;
246            if ($attr->{type} = ~ / ^text : digit / ) {
247              if ($value->{ $k } !~ / ^\d + $ / ) {
248                $ok = 0;
249              }
250            }
251            elsif($attr->{type} = ~ / ^(select | radio) : lower / ) {
252              $value->{$k} = ~tr / A - Z / a - z / ;
253              if (!defined($item_attr->{$k} {$value->{$k}})) {
254                $ok = 0;
255              }
256            }
257            elsif($attr->{type} = ~ / ^(select | radio) : upper / ) {
258              $value->{$k} = ~tr / a - z / A - Z / ;
259              if (!defined($item_attr->{$k} {$value->{$k}})) {
260                $ok = 0;
261              }
262            }
263            elsif($attr->{type} = ~ / ^checkbox / ) {
264              $value->{$k} = ~tr / A - Z / a - z / ;
265              if (!defined($value->{$k}) || $value->{ $k } eq '') {
266                $value->{$k} = 'false';
267              }
268              elsif(!($value->{ $k } eq 'true' || $value->{ $k } eq 'false')) {
269                $ok = 0;
270              }
271            }
272            if ($ok) {
273              if (!defined($value->{"default-$k"})) {
274                $value->{"default-$k"} = $value->{"$k"};
275              }
276            } else {
277              $value->{$k} = defined($value->{"default-$k"})
278                                 ? $value->{"default-$k"}
279                                 : $attr->{default};
280            }
281          }
282}
283
284sub get_config {
285  local($key) = @_;
286  local($k, $_);
287
288  if (!$key) {
289    $key = [keys % {$key_attr}];
290  }
291  open(TTY, "+>/dev/tty");
292        for
293          $k(@{$key}) {
294            $k = ~ / ^_ / &&next;
295            print TTY "\033]5380;$challenge;$k\007";
296            $_ = <TTY>;
297            $DEBUG &&print "DEBUG: get $_";
298            s /
299                ^\#${
300                    k} =  // || next;
301                chop;
302            $value->{$k} = $_;
303            $value->{"default-$k"} = $_;
304          }
305        close(TTY);
306}
307
308sub set_config {
309  local($val) = @_;
310  local(@key, $k, $_);
311
312  if ($val) {
313    @key = keys % {$val};
314  } else {
315    @key = keys % {$key_attr};
316    $val = $value;
317  }
318
319  open(TTY, ">/dev/tty");
320        for
321          $k(@key) {
322            $k = ~ / ^_ / &&next;
323            $val->{ $k }
324            eq $value->{"default-$k"} && next;
325            $DEBUG &&print "DEBUG: set $k=$val->{$k}\n";
326            print TTY "\033]5379;$k=$val->{$k}\007";
327            $value->{"default-$k"} = $val->{$k};
328          }
329        close(TTY);
330}
331
332sub load_config {
333  local($_, $k);
334
335  open(F, "<$config_file") || return;
336  while (<F>) {
337    s / ^(\w + )\s *=\s *  // || next;
338        $k = $1;
339    $k = ~tr / A - Z / a - z / ;
340    chomp;
341    $config->{$k} = $_;
342  }
343  close(F);
344}
345
346sub save_config {
347  local($k);
348  local($dir) = $config_file;
349
350  $dir = ~s @[ ^ / ] + $ @ @;
351  if (-d $dir) {
352    if (-f $config_file) {
353      rename($config_file, "$config_file.bak") || return;
354    }
355  } else {
356    mkdir($dir, 0700) || return;
357  }
358  open(F, ">$config_file") || return;
359        for
360          $k(split(" ", $value->{KEYS})) { print F "$k=$value->{$k}\n"; }
361        close(F);
362}
363
364sub make_save_config {
365  local($s, $attr, $k, $v, @ks);
366
367  print "Content-Type: text/html\n\n";
368  print << EOF;
369  <html><head><title> mlterm
370      configuration</ title></ head><body><center><b> mlterm
371          configuration</ b></ center><form action = "$CGI" method = POST><
372              input type = hidden name = "COOKIE" value = "$local_cookie"><p> Do
373              you save the configuration to $config_file
374      ? <br><input type = submit name = "SAVE" value =
375                 "Yes"><input type = submit name = "SAVE" value = "No"><hr> EOF
376        @ks = ();
377        for
378          $s(@section) {
379            $attr = $section_attr->{$s};
380                for
381                  $k(@{$attr->{key}}) {
382                    defined($config->{$k}) && delete $config->{$k};
383                    $v = $value->{$k};
384			if ($key_attr->{$k}{
385            type} eq 'none'
386				|| $key_attr->{$k}{default} eq '-'
387				|| $v eq $key_attr->{$k}{default}
388				|| $v eq '') {
389				next;
390			}
391              $v = &htvt_quote($v);
392              print "$k=$v<br>\n";
393              print "<input type=hidden name=\"$k\" value=\"$v\">\n";
394              push(@ks, $k);
395		}
396                  }
397        for
398          $k(sort keys % {$config}) {
399            $v = &htvt_quote($config->{$k});
400            print "$k=$v<br>\n";
401            print "<input type=hidden name=\"$k\" value=\"$v\">\n";
402            push(@ks, $k);
403          }
404        print << EOF;
405        <input type = hidden name =\"KEYS\" value=\"@ks\">
406                                   < / form></ body></ html> EOF
407          }
408
409        sub htvt_quote {
410          local($_) = @_;
411          local(% QUOTE) =
412              ('<', '&lt;', '>', '&gt;', '&', '&amp;', '"', '&quot;', );
413        s/[<>&"]/$QUOTE{$&}/g;
414	return $_;
415        }
416
417        sub form_decode {
418          local($_) = @_;
419          s /\+ / / g;
420          s / % ([\da - f][\da - f]) / pack('c', hex($1)) / egi;
421          return $_;
422        }
423