home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SATAN11.ZIP / PERL / HTML.PL < prev    next >
Encoding:
Perl Script  |  1995-04-11  |  10.6 KB  |  473 lines
  1. #!/usr/local/bin/perl5
  2. #
  3. # version 1, Thu Mar 23 21:53:31 1995, last mod by wietse
  4. #
  5.  
  6. #
  7. # Run an off-the-shelf HTML client against a dedicated HTML server.  The
  8. # server executes PERL files that are specified in HTML requests.
  9. #
  10. # Authentication is magic-cookie style via the file system.  This should
  11. # be good enough: the client-server conversation never goes over the
  12. # network so the magic cookie cannot be stolen by a network sniffer.
  13. # 
  14. # Values in POST attribute-value lists are assigned to the corresponding
  15. # global PERL variables.  See &process_html_request() for details.
  16. #
  17.  
  18. sub html {
  19.     local($helper, $wd, $host);
  20.  
  21.     #
  22.     # Start the HTML server and generate the initial cookie for
  23.     # client-server authentication.
  24.     #
  25.     $running_from_html = 1;
  26.     chmod 0700, <~/.mosaic*>;    # Yuck!
  27.     chmod 0700, <~/.netsca*>;    # Yuck!
  28.     chmod 0700, <~/.MCOM*>;        # Yuck!
  29.     &start_html_server();
  30.     &make_password_seed();
  31.  
  32.     #
  33.     # These strings are used in, among others, PERL-to-HTML scripts.
  34.     #
  35.     $wd = `pwd`;
  36.     chop $wd;
  37.     $html_root = "$wd/html";
  38.     $start_page = "satan.html";
  39.     $THIS_HOST = &getfqdn(&hostname());
  40.     die "Can't find my own hostname: set \$dont_use_nslookup in $SATAN_CF\n"
  41.         unless $THIS_HOST;
  42.     $HTML_ROOT = "file://localhost$html_root";
  43.     $HTML_SERVER = "http://$THIS_HOST:$html_port/$html_password/$html_root";
  44.     $HTML_STARTPAGE = "$HTML_ROOT/$start_page";
  45.  
  46.     #
  47.     # Some obscurity. The real security comes from magic cookies.
  48.     #
  49.     $html_client_addresses = find_all_addresses($THIS_HOST) ||
  50.         die "Unable to find all my network addresses\n";
  51.  
  52.     for (<$html_root/*.pl>) {
  53.         s/\.pl$//;
  54.         unlink "$_.html";
  55.         open(HTML, ">$_.html")
  56.             || die "cannot write $_.html: $!\n";
  57.         select HTML;
  58.         do "$_.pl";
  59.         close HTML;
  60.         select STDOUT;
  61.         die $@ if $@;
  62.     }
  63.  
  64.     #
  65.     # Fork off the HTML client, and fork off a server process that
  66.     # handles requests from that client. The parent process waits
  67.     # until the client exits and terminates the server.
  68.     #
  69.     print "Starting $MOSAIC...\n" if $debug;
  70.  
  71.     if (($client = fork()) == 0) {
  72.         foreach (keys %ENV) {
  73.             delete $ENV{$_} if (/proxy/i && !/no_proxy/i);
  74.         }
  75.         exec($MOSAIC, "$HTML_STARTPAGE") 
  76.             || die "cannot exec $MOSAIC: $!";
  77.     } 
  78.     if (($server = fork()) == 0) {
  79.         if (($helper = fork()) == 0) {
  80.             alarm 3600;
  81.             &patience();
  82.         }
  83.         &init_satan_data();
  84.         &read_satan_data() unless defined($opt_i);
  85.         kill 'TERM',$helper;
  86.         $SIG{'PIPE'} = 'IGNORE';
  87.         for (;;) {
  88.             accept(CLIENT, SOCK) || die "accept: $!";
  89.             select((select(CLIENT), $| = 1)[0]);
  90.             &process_html_request();
  91.             close(CLIENT);
  92.         }
  93.     }
  94.  
  95.     #
  96.     # Wait until the client terminates, then terminate the server.
  97.     #
  98.     close(SOCK);
  99.     waitpid($client, 0);
  100.     kill('TERM', $server);
  101.     exit;
  102. }
  103.  
  104. #
  105. # Compute a hard to predict number for client-server authentication. Exploit
  106. # UNIX parallelism to improve unpredictability. We use MD5 only to compress
  107. # the result.
  108. #
  109. sub make_password_seed {
  110.     local($command);
  111.  
  112.     die "Cannot find $MD5. Did you run a \"reconfig\" and \"make\"?\n"
  113.         unless -x "$MD5";
  114.     $command = "ps axl&ps -el&netstat -na&netstat -s&ls -lLRt /dev*&w";
  115.     open(SEED, "($command) 2>/dev/null | $MD5 |")
  116.         || die "cannot run password command: $!";
  117.     ($html_password = <SEED>) || die "password computation failed: $!";
  118.     close(SEED);
  119.     chop($html_password);
  120. }
  121.  
  122. #
  123. # Set up a listener on an arbitrary port. There is no good reason to
  124. # listen on a well-known port number.
  125. #
  126. sub start_html_server {
  127.     local($sockaddr, $proto, $junk);
  128.  
  129.     $sockaddr = 'S n a4 x8';
  130.     ($junk, $junk, $proto) = getprotobyname('tcp');
  131.     socket(SOCK, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  132.     listen(SOCK, 1) || die "listen: $!";
  133.     ($junk, $html_port) = unpack($sockaddr, getsockname(SOCK));
  134. }
  135.  
  136. #
  137. # Process one client request.  We expect the client to send stuff that
  138. # begins with:
  139. #
  140. #    command /password/perl_script junk
  141. #
  142. # Where perl_script is the name of a perl file that is executed via
  143. # do "perl_script";
  144. #
  145. # In case of a POST command the values in the client's attribute-value
  146. # list are assigned to the corresponding global PERL variables.
  147. #
  148. sub process_html_request {
  149.     local($request, $command, $script, $magic, $url, $peer);
  150.     local(%args);
  151.  
  152.     #
  153.     # Parse the command and URL. Update the default file prefix.
  154.     #
  155.     $request = <CLIENT>;
  156.     print $request if $debug;
  157.     ($command, $url) = split(/\s+/, $request);
  158.     if ($command eq "" || $command eq "QUIT") {
  159.         return;
  160.     }
  161.  
  162.     ($junk, $magic, $script) = split(/\//, $url, 3);
  163.     ($script, $html_script_args) = split(',', $script, 2);
  164.     ($HTML_CWD = "file:$script") =~ s/\/[^\/]*$//;
  165.  
  166.     #
  167.     # Make sure they gave us the right magic number.
  168.     #
  169.     if ($magic ne $html_password) {
  170.         &bad_html_magic($request);
  171.         return;
  172.     }
  173.  
  174.     #
  175.     # Assume the password has leaked out when the following happens.
  176.     #
  177.     $peer = &get_peer_addr(CLIENT);
  178.     die "SATAN password from unauthorized client: $peer\n"
  179.         unless is_member_of($peer, $html_client_addresses);
  180.     die "Illegal URL: $url received from: $peer\n" 
  181.         if index($script, "..") >= $[
  182.         || index($script, "$html_root/") != $[
  183.         || $script !~ /\.pl$/;
  184.  
  185.     #
  186.     # Warn them when the browser leaks parent URLs to web servers.
  187.     #
  188.     while (<CLIENT>) {
  189.         if (!$cookie_leak_warning && /$html_password/) {
  190.             &cookie_leak_warning();
  191.             return;
  192.         }
  193.         last if (/^\s+$/);
  194.     }
  195.  
  196.     if ($command eq "GET") {
  197.         perl_html_script($script);
  198.     } elsif ($command eq "POST") {
  199.  
  200.         #
  201.         # Process the attribute-value list.
  202.         #
  203.         if ($_ = <CLIENT>) {
  204.             s/\s+$//;
  205.             s/^/\n/;
  206.             s/&/\n/g;
  207.             $html_post_attributes = '';
  208.             $* = 1;
  209.             for (split(/(%[0-9][0-9A-Z])/, $_)) {
  210.                 $html_post_attributes .= (/%([0-9][0-9A-Z])/) ? 
  211.                     pack('c',hex($1)) : $_;
  212.             }
  213.             %args = ('_junk_', split(/\n([^=]+)=/, $html_post_attributes));
  214.             delete $args{'_junk_'};
  215.             for (keys %args) {
  216.                 print "\$$_ = $args{$_}\n" if $debug;
  217.                 ${$_} = $args{$_};
  218.             }
  219.             perl_html_script($script);
  220.         } else {
  221.             &bad_html_form($script);
  222.         }
  223.     } else {
  224.         &bad_html_command($request);
  225.     }
  226. }
  227.  
  228.  
  229. #
  230. # Map IP to string.
  231. #
  232. sub inet_ntoa {
  233.     local($ip) = @_;
  234.     local($a, $b, $c, $d);
  235.  
  236.     ($a, $b, $c, $d) = unpack('C4', $ip);
  237.     return "$a.$b.$c.$d";
  238. }
  239.  
  240. #
  241. # Look up peer address and translate to string form.
  242. #
  243. sub get_peer_addr {
  244.     local($peer) = @_;
  245.     local($junk, $inet);
  246.  
  247.     ($junk, $junk, $inet) = unpack('S n a4', getpeername($peer));
  248.     return &inet_ntoa($inet);
  249. }
  250.  
  251. #
  252. # Wrong magic number.
  253. #
  254. sub bad_html_magic {
  255.     local($request) = @_;
  256.     local($peer);
  257.  
  258.     $peer = &get_peer_addr(CLIENT);
  259.     print STDERR "bad request from $peer: $request\n";
  260.  
  261.         print CLIENT <<EOF
  262. <HTML>
  263. <HEAD>
  264. <TITLE>Bad client authentication code</TITLE>
  265. <LINK REV="made" HREF="mailto:satan\@fish.com">
  266. </HEAD>
  267. <BODY>
  268. <H1>Bad client authentication code</H1>
  269. The command: <TT>$request</TT> was not properly authenticated.
  270. </BODY>
  271. </HTML>
  272. EOF
  273. }
  274.  
  275. #
  276. # Unexpected HTML command.
  277. #
  278. sub bad_html_command {
  279.     local($request) = @_;
  280.  
  281.     print CLIENT <<EOF
  282. <HTML>
  283. <HEAD>
  284. <TITLE>Unknown command</TITLE>
  285. <LINK REV="made" HREF="mailto:satan\@fish.com">
  286. </HEAD>
  287. <BODY>
  288. <H1>Unknown command</H1>
  289. The command <TT>$request<TT> was not recognized.
  290. </BODY>
  291. </HTML>
  292. EOF
  293. }
  294.  
  295. #
  296. # Execute PERL script with extreme prejudice.
  297. #
  298. sub perl_html_script {
  299.     local($script) = @_;
  300.  
  301.     if (! -e $script) {
  302.         print CLIENT <<EOF
  303. <HTML>
  304. <HEAD>
  305. <TITLE>File not found</TITLE>
  306. <LINK REV="made" HREF="mailto:satan\@fish.com">
  307. </HEAD>
  308. <BODY>
  309. <H1>File not found</H1>
  310. The file <TT>$script</TT> does not exist or is not accessible.
  311. </BODY>
  312. </HTML>
  313. EOF
  314. ;        return;
  315.     }
  316.     do $script;
  317.     if ($@ && ($@ ne "\n")) {
  318.         print CLIENT <<EOF
  319. <HTML>
  320. <HEAD>
  321. <TITLE>Command failed</TITLE>
  322. <LINK REV="made" HREF="mailto:satan\@fish.com">
  323. </HEAD>
  324. <BODY>
  325. <H1>Command failed</H1>
  326. $@
  327. </BODY>
  328. </HTML>
  329. EOF
  330.     }
  331. }
  332.  
  333. #
  334. # Missing attribute list
  335. #
  336. sub bad_html_form {
  337.     local($script) = @_;
  338.  
  339.     print CLIENT <<EOF
  340. <HTML>
  341. <HEAD>
  342. <TITLE>No attribute list</TITLE>
  343. <LINK REV="made" HREF="mailto:satan\@fish.com">
  344. </HEAD>
  345. <BODY>
  346. <H1>No attribute list</H1>
  347.  
  348. No attribute list was found.
  349. </BODY>
  350. </HTML>
  351. EOF
  352. }
  353.  
  354. #
  355. # Scaffolding for stand-alone testing.
  356. #
  357. if ($running_under_satan == 1) {
  358.  
  359.     require 'perl/socket.pl';
  360.     require 'config/paths.pl';
  361.     require 'perl/hostname.pl';
  362.     require 'perl/getfqdn.pl';
  363.     require 'config/satan.cf';
  364.  
  365. } else {
  366.     $running_under_satan = 1;
  367.  
  368.     require 'perl/socket.pl';
  369.     require 'config/paths.pl';
  370.     require 'perl/hostname.pl';
  371.     require 'perl/getfqdn.pl';
  372.     require 'config/satan.cf';
  373.  
  374.     &html();
  375. }
  376.  
  377. #
  378. # Give them something to read while the server is initializing.
  379. #
  380. sub patience {
  381.     for (;;) {
  382.         accept(CLIENT, SOCK) || die "accept: $!";
  383.         <CLIENT>;
  384.         print CLIENT <<EOF
  385. <HTML>
  386. <HEAD>
  387. <TITLE>Initialization in progress</TITLE>
  388. <LINK REV="made" HREF="mailto:satan\@fish.com">
  389. </HEAD>
  390. <BODY>
  391. <H1>Initialization in progress</H1>
  392. SATAN is initializing, please try again later.
  393. </BODY>
  394. </HTML>
  395. EOF
  396. ;
  397.         close(CLIENT);
  398.     }
  399. }
  400.  
  401. # Look up all IP addresses listed for this host name, so that we can
  402. # filter out requests from non-local clients. Doing so offers no real
  403. # security, because network address information can be subverted.
  404. # 
  405. # All client-server communication security comes from the magic cookies
  406. # that are generated at program startup time. Client address filtering
  407. # adds an additional barrier in case the cookie somehow leaks out.
  408.  
  409. sub find_all_addresses {
  410.     local($host) = @_;
  411.     local($junk, $result);
  412.  
  413.     ($junk, $junk, $junk, $junk, @all_addresses) = gethostbyname($host);
  414.     for (@all_addresses) { $result .= &inet_ntoa($_) . " "; }
  415.     return $result;
  416. }
  417.  
  418. sub is_member_of {
  419.     local($elem, $list) = @_;
  420.  
  421.     for (split(/\s+/, $list)) { return 1 if ($elem eq $_); }
  422.     return 0;
  423. }
  424.  
  425. sub cookie_leak_warning {
  426.     print CLIENT <<EOF;
  427. <HTML>
  428. <HEAD>
  429. <TITLE>Warning - SATAN Password Disclosure</TITLE>
  430. <LINK REV="made" HREF="mailto:satan\@fish.com">
  431. </HEAD>
  432. <BODY>
  433. <H1><IMG SRC="$HTML_ROOT/images/satan.gif" ALT="[SATAN Image]">
  434. Warning - SATAN Password Disclosure</H1>
  435.  
  436. <HR>
  437.  
  438. <H3> 
  439.  
  440. Your Hypertext viewer may reveal confidential information when you
  441. contact remote WWW servers from within SATAN.
  442.  
  443. <p>
  444.  
  445. For this reason, SATAN advises you to not contact other WWW servers
  446. from within SATAN.
  447.  
  448. <p>
  449.  
  450. For more information, see <a
  451. href="$HTML_ROOT/tutorials/vulnerability/SATAN_password_disclosure.html">the
  452. SATAN vulnerability tutorial</a>.
  453.  
  454. <p>
  455.  
  456. This message will appear only once per SATAN session. 
  457.  
  458. <p>
  459.  
  460. In order to proceed, send a <i>reload</i> command (Ctrl-R with Lynx),
  461. or go back to the previous screen and select the same link or button
  462. again.
  463.  
  464. </H3>
  465.  
  466. </BODY>
  467. </HTML>
  468. EOF
  469.     $cookie_leak_warning = 1;
  470. }
  471.  
  472. 1;
  473.