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"> 118 <a name = "apply"><input type = submit name = "SUBMIT" value = "Apply"></ a> & 119 nbsp; 120 <input type = submit name = "SUBMIT" value = "Cancel"> 121 <input type = reset value = "Reset"> 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 " \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 " <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 ('<', '<', '>', '>', '&', '&', '"', '"', ); 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