#!@PERL @ $DEBUG = 1; use lib '@CGI_BIN@'; require 'mlconfig-data.pl'; open(CHALLENGE, "$ENV{HOME}/.mlterm/challenge"); $challenge = ; close(CHALLENGE); $config_file = "$ENV{HOME}/.mlterm/main"; $CGI = $ENV{SCRIPT_NAME} || $0; $CGI = &htvt_quote($CGI); $local_cookie = $ENV{LOCAL_COOKIE}; $method = ($ENV { REQUEST_METHOD } eq 'POST'); if ($method) { sysread(STDIN, $query, $ENV{CONTENT_LENGTH}); } else { $query = $ENV{QUERY_STRING}; } for (split('&', $query)) { s / ^([^=] *) = //; $value->{ $1} = &form_decode($_); } if ($local_cookie ne $value->{COOKIE}) { $method = 0; } if ($method) { if ($value->{SAVE}) { if ($value->{ SAVE } eq 'Yes') { &save_config(); } &make_header(0, $method); exit; } if ($value->{ SUBMIT } eq 'Cancel') { &make_header(1, $method); exit; } elsif($value->{full_reset}) { &set_config({full_reset = > '' }); &get_config(); &check_value(); } else { &check_value(); if ($value->{ SUBMIT } eq 'Save') { &load_config(); &make_save_config(); exit; } elsif($value->{ SUBMIT } eq 'OK') { &set_config(); &make_header(1, $method); exit; } elsif($value->{ SUBMIT } eq 'Apply') { &set_config(); } elsif($value->{fontsize_larger}) { &set_config({fontsize = > 'larger'}); &get_config(['fontsize']); } elsif($value->{fontsize_smaller}) { &set_config({fontsize = > 'smaller'}); &get_config(['fontsize']); } } } else { &get_config(); &check_value(); } &make_header(0, $method); &make_html(); sub make_header { local($quit, $method) = @_; if ($value->{SAVE}) { print "w3m-control: DELETE_PREVBUF\n"; print "w3m-control: BACK\n"; } elsif($quit && $value->{ QUIT } ne 'no') { print "w3m-control: EXIT\n"; } else { if ($value->{ SUBMIT } eq 'Apply') { print "w3m-control: GOTO #apply\n"; } else { print "w3m-control: GOTO #pos\n"; } print "w3m-control: DELETE_PREVBUF\n"; if ($quit || $method) { print "w3m-control: DELETE_PREVBUF\n"; } } print "Content-Type: text/html\n\n"; } sub make_html { local($s); print << EOF; mlterm configuration</ title></ head><body>< form action = "$CGI" method = POST><input type = hidden name = "COOKIE" value = "$local_cookie"><input type = hidden name = "QUIT" value = "$value->{QUIT}"><center><b> mlterm configuration</ b><table border = 1 width = 200> EOF $value->{SECTION} || = $value->{"default-SECTION"}; $value->{SECTION} = ~tr / A - Z / a - z / ; if (!defined($section_attr->{$value->{SECTION}})) { $value->{SECTION} = $section[0]; } &make_section($value->{SECTION}); print << EOF; <tr><td colspan = 2 align = center><nobr><input type = submit name = "SUBMIT" value = "OK">   <a name = "apply"><input type = submit name = "SUBMIT" value = "Apply"></ a> & nbsp; <input type = submit name = "SUBMIT" value = "Cancel">   <input type = reset value = "Reset">   <input type = submit name = "SUBMIT" value = "Save"></ nobr><tr align = center><td width = 50 %><table><tr><td> Font size<br><input type = submit name = "fontsize_larger" value = "Larger">< input type = submit name = "fontsize_smaller" value = "Smaller"></ table><td width = 50 %><table><tr><td> Full Reset<br><input type = submit name = "full_reset" value = "Full Reset"></ table></ table></ center></ form>< / body></ html> EOF } sub make_section { local($s) = @_; local($attr) = $section_attr->{$s}; local($k, $s2); print << EOF; <tr><td colspan=2 align=center><nobr> <input type=hidden name="default-SECTION" value="$s"> EOF for $s2 (@section) { if ($s eq $s2) { print "<b>[<a name=\"pos\">$section_attr->{$s}{title}</a>]</b>\n"; } else { print "<input type=submit name=\"SECTION\"", " value=\"$section_attr->{$s2}{title}\">\n"; } } print << EOF; </nobr> <tr><td colspan=2 align=center> <table> EOF for $k (@{$attr->{key}}) { &make_key($k); } print << EOF; </table> EOF for $s2 (@section) { $s eq $s2 &&next; $attr = $section_attr->{$s2}; for $k(@{$attr->{key}}) { print "<input type=hidden name=\"$k\" value=\"", &htvt_quote($value->{$k}), "\">\n"; print "<input type=hidden name=\"default-$k\" value=\"", &htvt_quote($value->{"default-$k"}), "\">\n"; } } } sub make_key { local($k) = @_; local($attr) = $key_attr->{$k}; local($type) = $attr->{type}; local($i); if (!$attr->{col}) { print "<tr>"; if ($type = ~ / ^checkbox / || $type = ~ / ^none / ) { print "<td colspan=2>\n"; } elsif($type = ~ / ^radio / ) { print "<td colspan=2><nobr>$attr->{title}\n"; } else { print "<td><nobr>$attr->{title}</nobr>\n"; print "<td>"; } } else { print " \n"; } if ($type = ~ / ^text / ) { print "<input type=text name=\"$k\" value=\"", &htvt_quote($value->{$k}), "\">\n"; } elsif($type = ~ / ^select / ) { print "<select name=\"$k\">\n"; for $i(@{$attr->{item}}) { print "<option value=\"$i\""; if ($value->{ $k } eq "$i") { print " selected"; } print ">"; print "$item_attr->{$k}{$i}\n"; } print "</select>\n"; } elsif($type = ~ / ^radio / ) { for $i(@{$attr->{item}}) { print " <input type=radio name=\"$k\" value=\"$i\""; if ($value->{ $k } eq "$i") { print " checked"; } print "> $item_attr->{$k}{$i}\n"; } print "</nobr>\n"; } elsif($type = ~ / ^checkbox / ) { print "<input type=checkbox name=\"$k\" value=\"true\""; if ($value->{ $k } eq "true") { print " checked"; } print ">\n"; print "$attr->{title}\n"; } elsif($type = ~ / ^none / ) { print "$attr->{title}\n"; return; } print "<input type=hidden name=\"default-$k\" value=\"", &htvt_quote($value->{"default-$k"}), "\">\n"; } sub check_value { local($k, $attr, $_, $ok); for $k(keys % {$key_attr}) { $k = ~ / ^_ / &&next; $attr = $key_attr->{$k}; $ok = 1; if ($attr->{type} = ~ / ^text : digit / ) { if ($value->{ $k } !~ / ^\d + $ / ) { $ok = 0; } } elsif($attr->{type} = ~ / ^(select | radio) : lower / ) { $value->{$k} = ~tr / A - Z / a - z / ; if (!defined($item_attr->{$k} {$value->{$k}})) { $ok = 0; } } elsif($attr->{type} = ~ / ^(select | radio) : upper / ) { $value->{$k} = ~tr / a - z / A - Z / ; if (!defined($item_attr->{$k} {$value->{$k}})) { $ok = 0; } } elsif($attr->{type} = ~ / ^checkbox / ) { $value->{$k} = ~tr / A - Z / a - z / ; if (!defined($value->{$k}) || $value->{ $k } eq '') { $value->{$k} = 'false'; } elsif(!($value->{ $k } eq 'true' || $value->{ $k } eq 'false')) { $ok = 0; } } if ($ok) { if (!defined($value->{"default-$k"})) { $value->{"default-$k"} = $value->{"$k"}; } } else { $value->{$k} = defined($value->{"default-$k"}) ? $value->{"default-$k"} : $attr->{default}; } } } sub get_config { local($key) = @_; local($k, $_); if (!$key) { $key = [keys % {$key_attr}]; } open(TTY, "+>/dev/tty"); for $k(@{$key}) { $k = ~ / ^_ / &&next; print TTY "\033]5380;$challenge;$k\007"; $_ = <TTY>; $DEBUG &&print "DEBUG: get $_"; s / ^\#${ k} = // || next; chop; $value->{$k} = $_; $value->{"default-$k"} = $_; } close(TTY); } sub set_config { local($val) = @_; local(@key, $k, $_); if ($val) { @key = keys % {$val}; } else { @key = keys % {$key_attr}; $val = $value; } open(TTY, ">/dev/tty"); for $k(@key) { $k = ~ / ^_ / &&next; $val->{ $k } eq $value->{"default-$k"} && next; $DEBUG &&print "DEBUG: set $k=$val->{$k}\n"; print TTY "\033]5379;$k=$val->{$k}\007"; $value->{"default-$k"} = $val->{$k}; } close(TTY); } sub load_config { local($_, $k); open(F, "<$config_file") || return; while (<F>) { s / ^(\w + )\s *=\s * // || next; $k = $1; $k = ~tr / A - Z / a - z / ; chomp; $config->{$k} = $_; } close(F); } sub save_config { local($k); local($dir) = $config_file; $dir = ~s @[ ^ / ] + $ @ @; if (-d $dir) { if (-f $config_file) { rename($config_file, "$config_file.bak") || return; } } else { mkdir($dir, 0700) || return; } open(F, ">$config_file") || return; for $k(split(" ", $value->{KEYS})) { print F "$k=$value->{$k}\n"; } close(F); } sub make_save_config { local($s, $attr, $k, $v, @ks); print "Content-Type: text/html\n\n"; print << EOF; <html><head><title> mlterm configuration</ title></ head><body><center><b> mlterm configuration</ b></ center><form action = "$CGI" method = POST>< input type = hidden name = "COOKIE" value = "$local_cookie"><p> Do you save the configuration to $config_file ? <br><input type = submit name = "SAVE" value = "Yes"><input type = submit name = "SAVE" value = "No"><hr> EOF @ks = (); for $s(@section) { $attr = $section_attr->{$s}; for $k(@{$attr->{key}}) { defined($config->{$k}) && delete $config->{$k}; $v = $value->{$k}; if ($key_attr->{$k}{ type} eq 'none' || $key_attr->{$k}{default} eq '-' || $v eq $key_attr->{$k}{default} || $v eq '') { next; } $v = &htvt_quote($v); print "$k=$v<br>\n"; print "<input type=hidden name=\"$k\" value=\"$v\">\n"; push(@ks, $k); } } for $k(sort keys % {$config}) { $v = &htvt_quote($config->{$k}); print "$k=$v<br>\n"; print "<input type=hidden name=\"$k\" value=\"$v\">\n"; push(@ks, $k); } print << EOF; <input type = hidden name =\"KEYS\" value=\"@ks\"> < / form></ body></ html> EOF } sub htvt_quote { local($_) = @_; local(% QUOTE) = ('<', '<', '>', '>', '&', '&', '"', '"', ); s/[<>&"]/$QUOTE{$&}/g; return $_; } sub form_decode { local($_) = @_; s /\+ / / g; s / % ([\da - f][\da - f]) / pack('c', hex($1)) / egi; return $_; }