#!/usr/bin/perl

  use strict;
  use CGI;
  use CGI::Carp qw(fatalsToBrowser);
  use Archive::Tar;
  use File::Basename;
  use File::Path;
  use File::Find;
  use File::Copy;
  
  my $cgi = new CGI;
  my $sOutput;
  my $sFileName;
  my $sDirName;
  my $sFileWebName;

  #----------------------------------
  sub fnFolderSelect
  {
    my $sFolderName = $_[0];
    my $sReturn;
    my $sFolderPath;
    my $sShortFolderPath;
    $sReturn .= "<select name='scriptdir'>\n";

    find(\&wanted, $sFolderName);
    sub wanted 
    {
      $sShortFolderPath = $File::Find::name;

      if (-d $File::Find::name)
      {
        if ($sShortFolderPath =~ /htdocs/)
        {
          $sShortFolderPath =~ s@.*/htdocs@/htdocs@;
        } 
        $sReturn .= 
          "<option value =\"${File::Find::name}\">\n".
          "  $sShortFolderPath\n".
          "</option>\n";
      }
    }
    $sReturn .= "</select>";
    return $sReturn;
  } #-- fn

  #----------------------------------
  sub fnFileSelect
  {
    my $sFolderName = $_[0];
    my $sFilter = $_[1];
    my $sReturn;
    my $sFilePath;
    my $sShortFilePath;
    $sReturn .= "<select name='archive'>\n";

    find(\&wanted1, $sFolderName);
    sub wanted1 
    {
      $sShortFilePath = $File::Find::name;

      if ($File::Find::name =~ /$sFilter/)
      {
        if ($sShortFilePath =~ /htdocs/)
        {
          $sShortFilePath =~ s@.*/htdocs@/htdocs@;
        } 
        $sReturn .= 
          "<option value =\"${File::Find::name}\"";
        if ($sShortFilePath =~ m@cgi-bin/$@) 
        {
          $sReturn .= " selected";
        }
        $sReturn .= 
          ">\n $sShortFilePath\n".
          "</option>\n";
      }
    }
    $sReturn .= "</select>";
    return $sReturn;
  } #-- fn

  #----------------------------------
  sub fnErrorMessage
  {
    my $sMessage = $_[0];
    my $sReturn;
    $sReturn .= "<h4>Installation problem</h4>";
    $sReturn .= $sMessage;
    $sReturn .= <<ENDF;
   <hr>
   <a href="install-site.cgi">try again</a>  
   </td>
   </tr>
   </table>   
ENDF
    return $sReturn;
  }

  #-- where the site content will go
  my $sContentDirectory = $cgi->param('contentdir');
  #-- if existing content should be overwritten
  my $sOverWriteContent = $cgi->param('overwrite');
  #-- where the perl scripts will go
  my $sScriptDirectory = $cgi->param('scriptdir');
  #-- a displayable name for the site
  my $sSiteAlias = $cgi->param('sitealias');
  #-- the language for site messages
  my $sLanguage = $cgi->param('language');
  my $sArchiveFile = $cgi->param('archive');
  my $sInstall = $cgi->param('install');
  my $sMode = $cgi->param('mode');
  my $sFileContents = $cgi->param('filecontents');  

  #my $sContentDirectoryWebName =~ s/%2F/\//;

  my $sDocumentRoot = $ENV{'DOCUMENT_ROOT'};
  #$sContentDirName = $ENV{'DOCUMENT_ROOT'} . '/' . $sContentDirWebName;
  my $sContentPath = "$sDocumentRoot/$sContentDirectory";
  my $sScriptPath = "$sDocumentRoot/$sScriptDirectory";
  if ($sArchiveFile =~ /^\//)
  {
    $sArchiveFile = $sDocumentRoot.$sArchiveFile;
  }  


  print $cgi->header();
  my $sCss .= <<ENDCSS;
  <!--
  body
  {
    background: lightgray;
    color: black;
  }
  -->
ENDCSS

    $sOutput .= 
      $cgi->start_html(
       -title=>'install site',
       -author=>'bumble.sf.net',
       -base=>'true',
       -style=>{-code=>$sCss},
       -meta=>{'keywords'=>'wiki perl apache html',
              'copyright'=>'gpl'});
    $sOutput .= <<END;

 <table align="center" width="70%">
   <tr>
   <td style="text-align:center; background:black; color:lightgreen;">
     <a style="color:lightgreen; text-decoration:none;" 
         href="/bib/">help</a> | 
     <a style="color:lightgreen; text-decoration:none;" 
         href="/" title="home">home</a> |
     <a style="color:lightgreen; text-decoration:none;" 
         href="install-site.cgi?mode=edit"
         title="edit install script">&para;</a> 
   </td>
   </tr>   
   <tr>
    <td style="background:white; color:black;">
END

  #-------------------------------------------------
  if (!$sMode)
  {
    my $sFolderSelect = fnFolderSelect($sDocumentRoot);
    my $sFileSelect = fnFileSelect($sDocumentRoot, '\.tar');
    $sOutput .= <<ENDA;
    <a name="installform" id="installform"></a>
    <h2>install the web site</h2>
    <form action='install-site.cgi' method='post'>

    <table>
      <tr>
       <td class="config-lable">site directory</td>
       <td>
        <input type="text" value="content" name="contentdir" size="10">
        <a href="#help-contentdir">[?]</a>
        Overwrite <input type="checkbox" name="overwrite" value="yes" />
        <a href="#help-overwrite">[?]</a>
       </td>
      </tr>
      <tr>
       <td class="config-lable">site alias</td>
       <td>
        <input type="text" value="" name="sitealias" size="10">
        <a href="#help-sitealias">[?]</a>
       </td>
      </tr>
      <tr>
        <td class="config-lable">script directory</td>
        <td>
         $sFolderSelect
         <input type="text" value="" name="scriptdir" size="10">
         <a href="#help-scriptdir">[?]</a>
        </td>
      </tr>
      <tr>
        <td class="config-lable">site archive</td>
        <td>
         $sFileSelect
         <input type="text" value="" name="archive" size="10">
         <a href="#help-archive">[?]</a>
        </td>
      </tr>
      <tr>
        <td class="config-lable">language</td>
        <td>
         <select name="language">
           <option value ="en">english</option>
           <option value ="es">spanish</option>
         </select>
         <a href="#help-language">[?]</a>
        </td>
      </tr>
      <tr>
       <td class="config-lable">delete site</td>
       <td>
        <input type="checkbox" name="mode" value="deleteconfirm" />
        <a href="#help-delete">[?]</a>
       </td>
      </tr>
      <tr>
        <td class="config-lable">
         <input type="hidden" value="1" name="install">
         <input type="hidden" value="install" name="mode">
        <input type='submit' value = 'I n s t a l l'>
        </td>
        <td>
        </td>
      </tr>
     </table>
     </form>
     <hr>
     <hr>
     <a name="help" id="help"></a>
     <!-- ------------------------------------- -->
     <h4>help</h4>
     <!-- ------------------------------------- -->
     <a name="help-general" id="help-general"></a>
     <h5>General help</h5>
      The <em>webweb</em> system is designed to run on an Apache webserver.
      The system will probably not work on another server because
      it makes use of specific features of Apache. The system uses
      perl scripts to generate pages and create an automatic interface
      to mysql databases. 
   
     <!-- ------------------------------------- -->
     <a name="help-scriptdir" id="help-scriptdir"></a>
     <h5>The script directory</h5>
      This is the directory where the cgi perl scripts will be placed.
      Consult your web-hosting documentation to find out where the 
      scripts should be placed. 
     <!-- ------------------------------------- -->
     <a name="help-contentdir" id="help-contentdir"></a>
     <h5>The content directory</h5>
      This is the name of the directory where the site will be
      created. The site will accessible via the url
      http://www.server.com/dir/ where 'dir' is the name of 
      the directory specified. This name should not contain any
      spaces.
     <!-- ------------------------------------- -->
     <a name="help-overwrite" id="help-overwrite"></a>
     <h5>The overwrite content option</h5>
     This checkbox specifies if the installation script
     will overwrite existing content on the server. It
     is someone risky to use this option.
     <!-- ------------------------------------- -->
     <a name="help-sitealias" id="help-sitealias"></a>
     <h5>The website name or alias</h5>
      This is the name which will appear for the site on webpages,
      and will be included in various messages. This does not affect
      the location of the website
     <!-- ------------------------------------- -->
     <a name="help-language" id="help-language"></a>
     <h5>The website user language</h5>
       This is the language in which messages will be written.
     <!-- ------------------------------------- -->
     <a name="help-archive" id="help-archive"></a>
     <h5>The archive file</h5>
       This is the file which contains all the scripts and templates
       which are used to create and maintain the site. This file
       should be uploaded to the web host. Without this file the site cannot
       be installed. The file either should be in the same folder
       as the installation script or should be specified relative to 
       the document root (eg /path/to/file.tar )
     <!-- ------------------------------------- -->
     <a name="help-delete" id="help-delete"></a>
     <h5>delete the entire site</h5>
       If this box is checked the site will be deleted,
       both the content and the perl scripts and htaccess
       rules.
      
   </td>
   </tr>
   </table>   
ENDA

    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } #-- if not install
  #------------------------------------------------------
  if ($sMode eq 'install')
  {
    $sOutput .= 
      $cgi->start_html(
       -title=>'install site',
       -author=>'bumble.sf.net',
       -base=>'true',
       -meta=>{'keywords'=>'wiki perl apache html',
              'copyright'=>'gpl'});


  $sOutput .=
     "<!-- query_string() = " . $cgi->query_string() . " --> \n" .
     "<!-- path_info() =" . $cgi->path_info() . "  --> \n" .
     "<!-- path_translated() =" . $cgi->path_translated() . " --> \n" .
     "<!-- referer() =" . $cgi->referer() . " --> \n" .
     "<!-- remote_addr() = " . $cgi->remote_addr() . " --> \n" .
     "<!-- DOCUMENT_ROOT = " . $ENV{'DOCUMENT_ROOT'} . " --> \n" .
     "<!-- request_method() =  " . $cgi->request_method() . "  --> \n";
 

 $sOutput .= <<END1;
   <pre>
     \$sScriptDirectory=$sScriptDirectory
     \$sScriptPath=$sScriptPath
     \$sContentDirectory=$sContentDirectory
     \$sContentPath=$sContentPath
     \$sSiteAlias=$sSiteAlias
     \$sLanguage=$sLanguage
     \$sArchiveFile=$sArchiveFile
     \$sInstall=$sInstall
     \$sMode=$sMode
   </pre>
END1

#------------------------------------------------
  my $sMessage;
  if (!$sContentDirectory) 
  {
    $sOutput .= fnErrorMessage(
         "No directory was specified for the site content.");
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 

#------------------------------------------------
  if ((-e $sContentPath) && (!$sOverWriteContent)) 
  {
    $sMessage = <<ENDF;
   The directory for the content '$sContentDirectory' ($sContentPath)
   <strong>already</strong> exists on the server. The site cannot be 
   installed to this folder because all current content in that folder
   would be overwritten (lost). Please choose a directory name that
   does not exist. 
ENDF
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 


#------------------------------------------------
  if (!$sScriptDirectory) 
  {
    $sMessage = <<ENDD;
    No directory was specified for the scripts.
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 

#------------------------------------------------
  if (!-e $sScriptPath) 
  {
    $sMessage = <<ENDF;
   The directory for the scripts '$sScriptDirectory' ($sScriptPath)
   does not exist on the server.
ENDF
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 


#------------------------------------------------
  if (!-d $sScriptPath) 
  {
    $sMessage= <<ENDG;
   The location for the scripts '$sScriptDirectory' ($sScriptPath)
   is not a directory.
ENDG
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 

#------------------------------------------------
  if (!$sArchiveFile) 
  {
    $sMessage = <<ENDD;
   No archive file was specified. This file contains the scripts and 
   templates used to create and maintain the site. 
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 

#------------------------------------------------
  if (!-e $sArchiveFile) 
  {
    $sMessage = <<ENDD;
   The archive file specified ($sArchiveFile) does not exist.
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  } 

  #-- a directory which is unlikely to exist
  my $sTempFolder = $sDocumentRoot.'/tmpAAA123BBB123xxx999';
  rmtree([$sTempFolder]); 
  my $bResult = mkdir($sTempFolder, 0777);
  if (!$bResult)
  {
    $sMessage .= <<ENDD;
   Could not create the temporary directory ($sTempFolder) 
   for extracting the archive file.
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  }

  $bResult = copy($sArchiveFile, "$sTempFolder");
  if (!$bResult)
  {
    $sMessage .= <<ENDD;
     File $sArchiveFile cannot be copied to $sTempFolder
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
  }

   chdir($sTempFolder);
   my $tar = Archive::Tar->new;
   $bResult = $tar->read("$sArchiveFile");
   if (!$bResult)
   {
     $sMessage .= <<ENDD;
      couldnt read $sArchiveFile
ENDD
    $sOutput .= fnErrorMessage($sMessage);
    $sOutput .= $cgi->end_html();
    print $sOutput;
    exit (0);
   }

   my @aaFiles = $tar->list_files();
   my $sFileName;
   my $sNewFileName;

   my $sOldContentDirectory;
   my $sOldScriptDirectory;

   foreach $sFileName (@aaFiles) 
   {
     if ($sFileName =~ m@/([^/]+)/css/scripts/data.css@)
     {
       $sOldContentDirectory = $1;
     }
     if ($sFileName =~ m@/([^/]+)/parse-page-description.cgi@)
     {
       $sOldScriptDirectory = $1;
     }

     $sNewFileName = $sFileName;
     $sNewFileName =~ s/.*\/htdocs//;
     $sOutput .= "$sNewFileName<br>";
     $bResult = $tar->rename($sFileName, $sNewFileName);
     if (!$bResult)
     {
       die "couldnt rename file $sFileName to $sNewFileName";
     }
   }

   if (!$sOldScriptDirectory)
   {
       die "file missing parse-page-description.cgi, cant install";
   }


   $sOutput .= <<END2;
   <pre>
     \$sOldScriptDirectory=$sOldScriptDirectory
     \$sOldContentDirectory=$sOldContentDirectory
   </pre>

END2
   my @aaExtractedFiles = $tar->extract();
   if (!@aaExtractedFiles)
   { 
     die "couldnt extract files from archive $sArchiveFile";
   }

   chdir($sDocumentRoot);
   if ($sOverWriteContent)
   {
     rmtree("$sDocumentRoot/$sContentDirectory"); 
   }

   $bResult = 
    rename("$sTempFolder/$sOldContentDirectory", 
           "$sDocumentRoot/$sContentDirectory");
   if (!$bResult)
   {
     die "couldnt rename $sTempFolder/$sOldContentDirectory to $sDocumentRoot/$sContentDirectory. $!";
   }


    my $file;
    my $sFileBaseName;
    my @directory = <$sTempFolder/$sOldScriptDirectory/*>;
    foreach $file (@directory)
    {
      $sFileBaseName = basename($file);
      print "$sDocumentRoot/$sScriptDirectory/$sFileBaseName <br>";
      if (!-e "$sDocumentRoot/$sScriptDirectory/$sFileBaseName")
      {}

    } 



   rmtree($sTempFolder); 

   $sOutput .= $cgi->end_html();
   print $sOutput;
   exit (0);

                                                                                                                                                                                                                                                                                                                      
  } #-- if mode 'install'               
  #--------------------------------------------------
  if ($sMode eq 'edit')
  {
    open(FILE, 'install-site.cgi') || die "Could not open install-site.cgi to edit !";
    $sOutput .= <<END1;

    <form action = 'install-site.cgi' method = 'post'> 
    <input type = 'submit' value = "s a v e">
      Editing script: <em>install-site.cgi</em>
    <br>
    <input type="hidden" name="mode" value="save">
    <textarea  
       style="background:black; color:lightgreen; font-family:courier, monospace;"
       name="filecontents"  cols = '90' rows = '20'>
END1

   while (my $sLine = <FILE>)
   {
      $sOutput .= $cgi->escapeHTML($sLine);
   }

   $sOutput .= <<END2;
   </textarea><br/>
   <input type = 'submit' value = "s a v e  s c r i p t"> 
  </form> 
END2

  $sOutput .= $cgi->end_html();
  print $sOutput;
  close(FILE);
	  
  exit (0);

  } #-- if mode=edit

  #--------------------------------------------------
  if ($sMode eq 'save')
  {
    if (!$sFileContents)
    {
      die "the 'filecontents' parameter does not seem to exist";
    } 
    copy('install-site.cgi', "install-site.cgi.1") || 
       die "couldnt copy $!";

    open(FILE, ">install-site.cgi") || 
      die "Could not open file install-site.cgi for writing! $!";
    print FILE "$sFileContents";

  $sOutput .= <<END1;
  saved the file install-site.cgi !
  <ul>
    <li>edit again <a href='install-site.cgi?mode=edit'>install-site.cgi</a> 
    <li>install site <a href='install-site.cgi'>install</a> 
    <li>backed up to <a href='install-site.cgi.1'>install-site.cgi.1</a>
  </ul>
END1

  $sOutput .= $cgi->end_html();
  print $sOutput;
  close(FILE);	  
  exit (0);

  } #-- if mode=save                                                         

  #--------------------------------------------------
  if ($sMode eq 'deleteconfirm')
  {

  $sOutput .= <<ENDX;
  <h3>Site deletion confirmation</h3> 

  Do you really want to delete the site and scripts
  and remove the htaccess rewrite rules?
    
  <pre>
  parameters
     \$sScriptDirectory=$sScriptDirectory
     \$sScriptPath=$sScriptPath
     \$sContentDirectory=$sContentDirectory
     \$sContentPath=$sContentPath
     \$sSiteAlias=$sSiteAlias
     \$sLanguage=$sLanguage
     \$sArchiveFile=$sArchiveFile
     \$sInstall=$sInstall
     \$sMode=$sMode
   </pre>
  
  <form action="install-site.cgi">
  
   <input type="hidden" name="scriptdir" value="$sScriptDirectory">
   <input type="hidden" name="contentdir" value="$sContentDirectory">
   <input type="hidden" name="sitealias" value="$sSiteAlias">
   <input type="hidden" name="language" value="$sLanguage">
   <input type="hidden" name="archive" value="$sArchiveFile">
   <input type="hidden" name="mode" value="delete">
   <input type="submit" value="delete site">

  </form>  
  <ul>
    <li><a href='install-site.cgi'>cancel (dont delete anything)</a> 
  </ul>
ENDX

  $sOutput .= $cgi->end_html();
  print $sOutput;
  close(FILE);	  
  exit (0);

  } #-- if mode=cleanconfirm

  #--------------------------------------------------
  if ($sMode eq 'delete')
  {

  $sOutput .= <<END1;
  <h3>Site deletion</h3> 

   <pre>
     \$sScriptDirectory=$sScriptDirectory
     \$sScriptPath=$sScriptPath
     \$sContentDirectory=$sContentDirectory
     \$sContentPath=$sContentPath
     \$sSiteAlias=$sSiteAlias
     \$sLanguage=$sLanguage
     \$sArchiveFile=$sArchiveFile
     \$sInstall=$sInstall
     \$sMode=$sMode
   </pre>
    
  <ul>
  </ul>
END1
  if (-e $sContentPath)
  {
    rmtree($sContentPath); 
  }

  $sOutput .= $cgi->end_html();
  print $sOutput;
  close(FILE);	  
  exit (0);

  } #-- if mode=delete