#!/usr/bin/perl -w
# browse: Display the "reference" using the Secure BROWSER convention.
#  It converts the reference to an absolute reference, then calls the
#  colon-separated commands given in BROWSER in turn to view it.
#  Returns 0 on sucess, non-zero on failure.
#  You can get this program and spec from "http://www.dwheeler.com/browse".
#
# WARNING!  From a non-shell, DO NOT invoke this program through a shell.
#
# Version 2.2, 2001-02-24.
# (C) Copyright 2001 David A. Wheeler (dwheeler@dwheeler.com).
# Released using the "MIT/X" license.

use Cwd;
use strict;


# Invoke browser, given absolute reference and optional overriding value,
# using the Secure BROWSER convention.  Returns 1 on success, 0 on failure.

sub invoke_browser {
  my $absolute_reference = shift;
  my $browser = shift;   # If not provided, uses BROWSER variable.
  my $command;

  return 0 unless defined($absolute_reference); # Need a reference.
  if (($absolute_reference !~ m!^!) && ($absolute_reference !~ m!^[a-z]+:!)) {
    return 0;  # Not a legal absolute reference.
  }

  # Perform shell escape (by inserting backslashes); REQUIRED for security.
  $absolute_reference =~
    s/([\&\;\`\'\\\"\|\*\?\~\<\>\^\(\)\[\]\{\}\$\010\013\020\011])/\\${1}/g;

  if (! defined($browser)) {
    $browser = $ENV{"BROWSER"};
    if (!defined($browser)) {return 0;}  # Can't get a value for BROWSER.
  }

  for (split(/:/, $browser)) {  # Break up BROWSER and execute.
    next if (m/^$/);  # We ignore empty command parts, for security reasons.
    $command = $_;
    $command .= " %s" if (!/%s/);
    $command =~ s/%(.)/if ($1 eq 's') {$absolute_reference;}
                       elsif ($1 eq 'c') {":";}
                       else {"$1";}/eg;  # For other chars, just return char.

    if (! system($command)) {return 1;}  # Try to run, return if success.
  }
  return 0;  # All parts tried, none succeeded.
}


# This is sample code to implement the "alternate" form of BROWSER -
# it's much simpler, and easier to check for security, but it
# has a different syntax for the BROWSER environment variable.

sub alternate_invoke_browser {
  my $absolute_reference = shift;
  my $browser = shift;   # If not provided, uses BROWSER variable.
  my @command_list;

  return 0 unless defined($absolute_reference); # Need a reference.
  if (($absolute_reference !~ m!^!) && ($absolute_reference !~ m!^[a-z]+:!)) {
    return 0;  # Not a legal absolute reference.
  }

  if (! defined($browser)) {
    $browser = $ENV{"BROWSER"};
    if (!defined($browser)) {return 0;}  # Can't get a value for BROWSER.
  }

  for (split(/:/, $browser)) {  # Break up BROWSER and execute.
    next if (m/^$/);  # We ignore empty command parts, for security reasons.
    @command_list = split();                   # Split command on spaces.
    push @command_list, $absolute_reference;   # Add reference to view.
    if (! system(@command_list)) {return 1;};  # Return 1 if success.
  }
  return 0;  # All parts tried, none succeeded.
}



# Return current working directory with a "/" at the end.
sub cwd_slashed {
  my $pwd = getcwd();
  if ($pwd !~ m!/$!) { $pwd .= '/';}  # Append "/" if not there.
  return $pwd;
}


# Given reference, base, and flags, return an absolute reference.
# An absolute reference is a pathname beginning with "/" or a URI
# beginning with [a-z]+:.  Returns "undef" if it can't convert it.
# If the reference is already absolute, it's returned unchanged.
# The "Secure BROWSER" convention doesn't require this - it only
# requires support of absolute references - but this is useful.

sub absolute_reference {
  my ($reference, $base, $flags) = @_;
  return undef unless defined($reference);
  $base = "" unless $base;
  $flags = "" unless $flags;
  my ($prefix, $base_scheme, $base_host, $cd_up);

  if ($flags =~ m/d/) { $cd_up = '/';}  # Base is a DIRECTORY, not a document.
  else                { $cd_up = '/../';}

  # Compute the absolute URI/pathname:
  if (!($flags =~ m/n/)) {
   if ( ($flags =~ m/f/) ||
        (($flags !~ m/u/) && ($reference =~ m!^/!))) { # filename
     if ($reference !~ m!^/!) { # Non-absolute filename, let's fix it:
         if ($base =~ m!^/!) {  # Use the base if it's absolute.
           $reference = $base . $cd_up . $reference;
         } else {
           $reference = &cwd_slashed() . $reference;
         }
     }
     $reference =~ s/\000//g;  # Eliminate any NUL characters.
     if ($reference =~ m/[\001-\017\200-\377]/) { # Change it to URI/URL.
          $reference =~ s/([^A-Za-z0-9\-\_\.\!\~\*\'\(\)\/])/sprintf("%%%02x",ord($1))/eg;
          $reference = 'file:' . $reference;
     }
   } else {  # Must be URI/URL.
     # Implement prefixes, an option in the "Secure BROWSER" spec:
     $prefix = "";
     if ($base) {  # There's a $base.
       if ($base =~ m!^/!) { # The base is an absolute filename, turn into URL.
          $base =~ s/([^A-Za-z0-9\-\_\.\!\~\*\'\(\)\/])/sprintf("%%%02x",ord($1))/eg;
          $base = 'file:' . $base;
       } elsif ($base !~ m/^[a-z]+:/) {
         return undef;  # The base isn't valid!
       }
       $base =~ m!^([a-z]+):/*([^/]*)!;
       $base_scheme = $1;
       $base_host = $2;
       if    ($reference =~ m!^[a-z]+:!) {}
       elsif ($reference =~ m!^//!) {$prefix = $base_scheme . ':';}
       elsif ($reference =~ m!^/!) {$prefix = "$base_scheme://$base_host";}
       elsif ($reference =~ m!^\#!) {$prefix = $base;}
       elsif ($reference eq "")    {$prefix = $base;}
       else                  {$prefix = $base . $cd_up;}
     } else { # No base
       if    ($reference =~ m!^[a-z]+:!) {}
       elsif ($reference =~ m!^/!) {$prefix = 'file:';}
       elsif ($reference =~ m!^#! || $reference eq "" || $reference =~ m!^\./!)
                      {$prefix = 'file:' . cwd_slashed();}
       else { # Relative URL.
         if (($flags =~ m/m/) && ($reference =~ m!^www\.!)) {$prefix = 'http://';}
         elsif (($flags =~ m/m/) && ($reference =~ m!^ftp\.!)) {$prefix = 'ftp://';}
         elsif ($flags =~ m/r/) {}
         elsif ($flags =~ m/R/) {$prefix = 'file:' . cwd_slashed();}
         else  {$prefix = 'http://';}
      }
     }
     $reference = $prefix . $reference;
     # Escape all completely illegal characters
     # in a URI/URL as "%hh" (including %00):
     $reference =~ s/([^;\/\?\:\@\&=\+\$\,\#\%A-Za-z0-9\-\_\.\!\~\*\'\(\)])/sprintf("%%%02x",ord($1))/eg;
   }
  }
  return $reference;
}



# MAIN PROGRAM #

my $flags = my $base = "";
my $arg;
my $browser = undef;

while (($#ARGV >= 0) && ($ARGV[0] =~ m/^-/)) {
  $arg = shift;
  if ($arg eq "--") {last;}
  elsif ($arg eq "--magic") {$flags .= "m";}
  elsif ($arg eq "--nochange") {$flags .= "n";}
  elsif ($arg eq "--relative") {$flags .= "r";}
  elsif ($arg eq "--file") {$flags .= "f";}
  elsif ($arg eq "--relfile") {$flags .= "R";}
  elsif ($arg eq "--url") {$flags .= "u";}
  elsif ($arg eq "--uri") {$flags .= "u";}
  elsif ($arg eq "--dir") {$flags .= "d";}
  elsif ($arg eq "--base") {$base = shift;}
  elsif ($arg eq "--browser") {$flags .= "b";}
}

if ($#ARGV < 0) {
 die "Sorry, must provide the reference to view";
} elsif ($#ARGV > 0) {
 die "Sorry, too many arguments";
} elsif (($base eq "") && ($ARGV[0] eq "")) {
 die "Sorry, without a base a reference cannot be blank";
}


if (defined($browser = $ENV{"BROWSER_OVER_RIDE"})) {
  delete @ENV{qw(BROWSER_OVER_RIDE)};
} elsif (!defined($ENV{"BROWSER"}) && !$flags =~ "b") {
  $browser = "netscape -raise -remote \"openURL(%s,new-window)\":lynx";
}

# Do this instead to use the alternative convention:
# exit(!alternate_invoke_browser(absolute_reference($ARGV[0], $base, $flags), $browser));

exit(!invoke_browser(absolute_reference($ARGV[0], $base, $flags), $browser));