#!/usr/local/bin/perl
use lib '/usr/local/rib/lib';
# NHSE Repository in a Box (RIB)
#
# The authors of this software are Paul McMahan and Jeff Horner.
# Copyright (c) 1997 by the University of Tennessee.
# Permission to use, copy, modify, and distribute this software for any
# purpose without fee is hereby granted, provided that this entire notice
# is included in all copies of any software which is or includes a copy
# or modification of this software and in all copies of the supporting
# documentation for such software.
# THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTY.  IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE
# MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE
# MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
#
# $Id: install_file.pl,v 1.2 1997/12/18 18:08:57 rib Exp $
#
# $Log: install_file.pl,v $
# Revision 1.2  1997/12/18 18:08:57  rib
#         - Changed gen_catalog so that the input box for the search on the top level
#           catalog page isn't so wide.  changed to SIZE=45
#
#         - fixed a bug in install_file.pl which caused the header/footer file on
#           the verification page to be encoded in the <input> box but not in the
#           regular body of the page.
#
#         - fixed a bug in gen_catalog which caused the documents in catalog/ to
#           be indexed instead of the documents in catalog/*/
#
#         - added a note to edit_object.pl that tells the user that they need
#           to update the catalog if the object was an asset and if a catalog
#           currently exists.
#
#         - changed add_nonlocal_link.pl to not be so strict in checking the urls
#           before it attempts to add them.  it no longer counts a url that's
#           already in the repository as an error leading towards exit
#
# Revision 1.1.1.1  1997/12/10 15:59:31  jhorner
# RIB pre 1.0
#
# Revision 1.1  1997/05/06 18:18:00  jhorner
# Initial revision
#
undef $/;
use strict;
use RIB::Util ();
use RIB::ConfigParser ();
use LWP::UserAgent ();
use HTTP::Request ();
use HTML::Entities ();

my $util = RIB::Util->new();
my $cp = RIB::ConfigParser->new();
my %in = RIB::Util->ReadParse();
$util->PrintHeader();

my $repository = $util->GetRepoName();
if (!$repository) {
  $util->ErrorMessage("repository was not specifed in your input.");
}

my $filepath = $util->GetRibDir() . "/repositories/" . $repository;
my $urlpath  = $util->GetRibUrl() . "/repositories/" . $repository;

$cp->load_config("$filepath/conf/BIDM.conf");
my @classes = sort $cp->Classes();

my $back_to_top = $util->BackToTop($repository);

unless ($in{filetype}){
    $util->ErrorMessage("incorrect filetype in input ($in{filetype})");
}

my ($file,$desc,$backup_copy,$class,$part);
if ($in{filetype} eq 'config') {
  $file = "$filepath/conf/BIDM.conf";
  $desc = "Configuration";
  unless (open(OLD, "<$file") && ($backup_copy = <OLD>) && close(OLD)){
    $util->ErrorMessage("Couldn't read the file &quot;$file&quot;. "
    . "Reason: $!<p>Please contact your RIB administrator!<br>");
  }
} elsif ($in{filetype} eq 'domains') {
  $file = "$filepath/conf/domains.html";
  $desc = "Domains";
  unless (open(OLD, "<$file") && ($backup_copy = <OLD>) && close(OLD)){
    $util->ErrorMessage("Couldn't read the file &quot;$file&quot;. "
    . "Reason: $!<p>Please contact your RIB administrator!<br>");
  }
} elsif ($in{filetype} =~ /main\.(header|footer)/ ){
    $file = "$filepath/conf/$in{filetype}";
    $desc = "Catalog $1";
    $class = 'main';
    $part = $1;
    if ($part eq 'header'){ $backup_copy = $util->ClassHeader("main"); 
    } else { $backup_copy = $util->ClassFooter("main"); }
} else {
    my $flag;
    foreach (@classes){
	if ($in{filetype} =~ /${_}\.(header|footer)/ ){
	    $part = $1;
	    $flag = 1;
	    $file = "$filepath/conf/$in{filetype}";
	    ($desc = $in{filetype}) =~ s/\./ /;
	    $class = $_;
	    if ($part eq 'header'){ $backup_copy = $util->ClassHeader($class);
	    } else { $backup_copy = $util->ClassFooter($class); }
	    last;
	}
    }
    unless ($flag) {
	$util->ErrorMessage("incorrect filetype in input ($in{filetype})");
    }
}

my $top = "<head><title>Install $desc file for "
     . "$repository</title></head>\n"
     . "<body bgcolor=#FFFFF0>"
     . "<center>"
     . "<h1>Install $desc file for $repository</h1>\n"
     . "</center>"
     . "<p><hr><p>\n";



if ($in{new_file}) {
  unless (open(NEW, ">$file")) {
    $util->ErrorMessage("Couldn't write to the file &quot;"
                     . "$file&quot;. "
                     . "Reason: $!<p>To correct this error you "
                     . "may need to ensure that the permissions on this "
                     . "file allow the user &quot;"
                     . $util->GetUserName() . "&quot; "
                     . "to write to this file.");
  }
  unless (print NEW $in{new_file}) {
    if ($backup_copy and open (TMP, ">/tmp/backup.$$")) {
      print TMP $backup_copy; close(TMP);
    }
    $util->ErrorMessage("Couldn't write the new output file at "
                     . "&quot;$file&quot;. "
                     . "Reason: $!<p>To correct this error you "
                     . "may need to ensure that the permissions on this "
                     . "file allow the user &quot;"
                     . $util->GetUserName() . "&quot; "
                     . "to write to this file.  The old $in{file_type} file "
                     . "for this repository was destroyed in the attempt to "
                     . "replace it.  A backup copy of the old $in{file_type} "
                     . "file (if one existed) was attempted to be saved at "
                     . "the location &quot;"
                     . "/tmp/backup.$$&quot;.  If you cannot retrieve the "
                     . "copy of the old file from that "
                     . "location then you should be able to press the "
                     . "&quot;back&quot; button on your browser and save "
                     . "a copy of the old $in{file_type} file "
                     . "from the previous page.<p>This repository "
                     . "cannot function "
                     . "properly until a $in{file_type} file has been put "
                     . "in the location &quot;$file&quot;.");
  }
  close NEW;

    # here is the place where we change catalog descriptions

    select(STDOUT); $| = 1;

    #
    # For the index.html
    #   
    if (defined $class && $class eq 'main'){
	my $buf; my $file = "$filepath/catalog/index.html";
	print $top;
	if(-f $file and -s $file){ 
	    if (open(MAIN,"<$file")){
		$buf = <MAIN>; close(MAIN);
		if($buf =~ s/\Q$backup_copy\E/$in{new_file}/){
		    if(open(MAIN,"+>$file")){
		       print MAIN $buf; close (MAIN);
		    } else {
			print "<br>Unable to overwrite "
			. "$filepath/catalog/index.html: $!<br>\n";
		    }
		} else {
		    print "<br>Couldn't change the $part in "
		    . "$filepath/catalog/index.html<br>";
		}
	    } else {
		print "<br>Unable to open "
		. "$filepath/catalog/index.html: $!<br>\n";
	    }
	}
    #huh?  ----|
    #          v
    #print "<br>Updating the main Catalog Page<br>";

    } elsif (defined $class) {
    #
    # For each catalog entry
    #   
	my $buf; my $filedir = "$filepath/catalog/$class";
	print $top;
	unless (opendir (DIR,$filedir)) {
	    print "<br>Unable to open $filedir: $!<br>\n";
	}
	foreach ( grep(/.*\.[hH][tT][mM][lL]?$/,readdir(DIR))){
	    if(open(F,"<$filedir/${_}") && ($buf = <F>) && close(F)){
		if($buf =~ s/\Q$backup_copy\E/$in{new_file}/){
		    if(open(F,"+>$filedir/${_}") && (print F $buf) && close (F)){
		    } else {
			print "<br>Unable to overwrite "
			. "$filedir/${_}: $!<br>\n";
		    }
		} else {
		    print "<br>Match failed: Couldn't change the $part in "
		    . "$filedir/${_}<br>";
                    #print "<pre>", HTML::Entities::encode($backup_copy);
                    #print "<p>", HTML::Entities::encode($buf), "</pre>\n";
		}
	    } else {
		print "<br>Unable to open "
		. "$filedir/${_}: $!<br>\n";
	    }
	    print "<br>Updating ${_}<br>\n";
	}

    }

  print "<br><strong>Success</strong><p>\n";
  print "The new file has been installed.\n";
  #if ($in{filetype} eq 'asset_header'
  #    or $in{filetype} eq 'asset_footer'
  #    or $in{filetype} eq 'main_header'
  #    or $in{filetype} eq 'main_footer') {
  #  if (-f $filepath."/catalog/index.html") {
  #    print "<p>The new $in{filetype} will not show in this repository's\n";
  #    print "software catalog until the catalog is (re)generated.\n";
  #  }
  #}
  print $back_to_top;
  exit;
} elsif (exists $in{url} and $in{url} =~ /\S/) {
  unless ($in{url} =~ /^\s*\w+:\/\//) {
    $in{url} = "file://localhost/" . $in{url};
    if ($in{url} =~ /\/etc\//) {
      $util->ErrorMessage("The path to your new file cannot contain "
                       . "&quot;/etc/&quot;.  This is for security reasons. "
                       . "Please copy your new file to "
                       . "a different directory that does not contain "
                       . "&quot;/etc/&quot; and then submit it from that "
                       . "directory.");
    }
  }
  if ($in{url} =~ /^\s*file:\/\// && $in{url} =~ /\/etc\//) {
    $util->ErrorMessage("The path to your new file cannot contain "
                     . "&quot;/etc/&quot;.  This is for security reasons. "
                     . "Please copy your new file to "
                     . "a different directory that does not contain "
                     . "&quot;/etc/&quot; and then submit it from that "
                     . "directory.");
  }
  my $ua = LWP::UserAgent->new("RIB/1.0");
  my $req = HTTP::Request->new('GET',$in{url});
  my $res = $ua->request($req);
  if ($res->is_error){
    $util->ErrorMessage("Couldn't retrieve " . $req->url . ": "
                     . $res->code. " ". $res->message);
  }
################################################
  print <<"EOF";
$top
Are you sure that you want to install the following file for this repository?
<table><tr><td>
<form method=post action=install_file.pl>
<input type=hidden name=new_file 
EOF
################################################
  print 'value="',HTML::Entities::encode($res->content()),'">';
################################################
  print <<"EOF";
<input type=hidden name=filetype value=$in{filetype}>
<input type=submit value=yes>
</form></td><td>
<form method=post action=install_file.pl>
<input type=hidden name=filetype value=$in{filetype}>
<input type=submit value=no>
</form></td></tr></table><p><pre>
EOF
################################################
  print HTML::Entities::encode($res->content()), "\n";
  print "</pre>\n$back_to_top";
################################################
  exit(0);
} elsif (exists $in{textarea} and $in{textarea} =~ /\S/s) {
################################################
  print <<"EOF";
$top
Are you sure that you want to install the following
file for this repository?
<table><tr><td>
<form method=post action=install_file.pl>
<input type=hidden name=new_file
EOF
################################################
  print 'value="',HTML::Entities::encode($in{textarea}),'">';
################################################
  print <<"EOF";
<input type=hidden name=filetype value=$in{filetype}>
<input type=submit value=yes>
</form>
</td><td>
<form method=post action=install_file.pl>
<input type=hidden name=filetype value=$in{filetype}>
<input type=submit value=no>
</form>
</td></tr></table><p>
<pre>
EOF
  print HTML::Entities::encode($in{textarea});
  print <<"EOF";
</pre>
$back_to_top
EOF
################################################
  exit(0);
} else {
################################################
  print <<"EOF";
$top
<form method=post action=install_file.pl>
<p>
To install a new $desc file for this repository
please choose either option 1 or option 2 below.
EOF
################################################
  (my $url = $file) =~ s/\Q$filepath\E/$urlpath/;
################################################
  print <<"EOF";
<p>
<strong>Option 1:</strong>
<br>
Import a file from the Internet or local file system.
If the new file is accessible via http, ftp, or gopher then
you can input a url to that file in the input box below.
If the file is available on the same machine where RIB
is installed then you can input the full pathname to the 
file instead of using a url.
<p>
<input size=75 name=url>
<input type=hidden name=filetype value=$in{filetype}>
<br><input type=submit value=Submit>
<p><hr><p>
<strong>Option 2:</strong>
<br>
You can paste the contents of the file that you wish to
install into the area below.  <strong>For ease of editing your 
current file</strong>, it will always be loaded into 
the text area below, if it exists.
<p>
<textarea cols=80 rows=15 name=textarea>
$backup_copy
</textarea>
<br><input type=submit value=Submit>
</form>
$back_to_top
EOF
################################################
}