gnuift-perl 0.1.14-12.1 / usr / bin / gift-start.pl

#!/usr/bin/perl -w # -*- mode: perl -*-

#     GIFT, a flexible content based image retrieval system.
#     Copyright (C) 1998, 1999, 2000, 2001, 2002, CUI University of Geneva

#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.

#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.

#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


#
# this script starts the gift and opens at least one session
#

use IO::Socket;
use lib '/usr/bin';		# for including CFeedbackClient
use CXMLTreeWriter;
use CXMLTreeBuilder;
use CXMLTreeVisitor;
use Net::SMTP;
use POSIX ":sys_wait_h";
use Getopt::Long;
use strict;
use vars qw($lHost 
	    $lPort
	    $gMailTo
	    $gMailFromUser
	    $gSMTPHost
	    $lDirectory
	   );


print "

gift-start.pl [--gift-host host] [--gift-port port] [--gift-home gift-home] \\
              [--smtp-host host] [--mail-from-user user(s)] [--mail-to user(s)]


This program starts one instance of the GIFT. If this instance dies,
it will send out a message to a list of addresses, saying that the
GIFT has died. It will then automatically restart the GIFT.

STDOUT from the GIFT will be redirected to /dev/null

--gift-host   this is the host the GIFT will listen to
              (currently NOT USED)
--gift-port   this is the port the GIFT will listen to
--gift-home   this is the directory where the GIFT will expect its
              configuration data.
--smtp-host   this is the smtp host which will be used for sending out mail
--mail-to     a mail will be sent to this user. 
              THIS CAN BE A COMMA-SEPARATED LIST OF EMAIL ADDRESSES
--mail-from-user
              This program will contact the SMTP server as the following user
";


# Begin:
#  this code is taken from the perlipc manpage
#
sub REAPER {
  my $child;
  $child = wait;
  # loathe sysV: it makes us not only reinstate
  # the handler, but place it after the wait
  $SIG{CHLD} = \&REAPER;
}

# End:
#  this code is taken from the perlipc manpage
#

print "$0: Diagnose: I just installed the REAPER\n";



($lHost,$lPort)=split(":","localhost:12789");
 $lDirectory=$ENV{GIFT_HOME} || $ENV{HOME};

$gSMTPHost="localhost";
$gMailTo="root\@localhost";
$gMailFromUser=$ENV{USER};

GetOptions('gift-home=s'=>\$lDirectory,
	   'gift-host=s'=>\$lHost,
	   'gift-port=s'=>\$lPort,
	   'smtp-host=s'=>\$gSMTPHost,
	   'mail-from-user=s'=>\$gMailFromUser,
	   'mail-to=s'=>\$gMailTo);

 die "something wrong, no gift-home directory given" unless $lDirectory;


while(1){
  print "doing ps\n";
  open PS,"ps -axww|" or die "could not ps";
  
  my $lFound=0;
  my $lPID=0;
  while(<PS>){
    my $lLine=$_;
    my(@lParsed)=split(/:\d\d\s/,$lLine);
    my $lCall=$lParsed[-1];
    
    if($lCall=~m/gift\s+(\d+)/){
      
      print "FOUND GIFT WITH PORT $1\n";
      
      if($1 == $lPort){
	$lFound=1;
	$lParsed[0]=~m/^\s+(\d+)/;
	$lPID=$1;
      }
    }
  }
  unless($lFound){
    $SIG{CHLD} = \&REAPER;
    print "Before fork to sendit";
    if(fork == 0){
      &sendIt($lHost,$lPort);
      die "Sendit dies";
    }else{

      my $lCallstring="/usr/bin/gift $lPort $lDirectory > /dev/null";
      
      system("$lCallstring");
      print STDERR "gift DIED!\nCalled: $lCallstring\n";
      print STDERR "trying to send mail to $gMailTo, using $gSMTPHost, user $gMailFromUser\n";

      my $smtp = Net::SMTP->new($gSMTPHost) or die "NO MAILHOST $gSMTPHost";
      $smtp->mail($gMailFromUser) or die "Sending mail failed:  $!";
      $smtp->to((split(",",$gMailTo))) or die "Sending mail failed:  $!";
      
      $smtp->data() or die "Sending mail failed:  $!";
      $smtp->datasend("To: $gMailTo\n") or die "Sending mail failed:  $!";
      $smtp->datasend("Subject: [dead-GIFT] $lHost:$lPort Reviving: $lCallstring\n") or die "Sending mail failed:  $!";
      $smtp->datasend("\n") or die "Sending mail failed:  $!";
      $smtp->datasend("$lCallstring\n
just died
It has been restarted automatically.

this message has been generated automatically by
$0
") or die "Sending mail failed:  $!";
      $smtp->dataend() or die "Sending mail failed:  $!";
      
      $smtp->quit or die "Sending mail failed:  $!";
      print "Mail successfully sent to $gMailTo\n";
      sleep 10;
      
    }
  }else{
    sleep 300;#sleep for 5 minutes and try again
  }
}


sub sendIt( $$ ){
  my $lHost=shift;
  my $lPort=shift;
  sleep 5;
  my $self={};
  my $lTree={
	     element=>"mrml",
	     attributes=>{
			 },
	     children=>[
			{
			 element=>"open-session",
			 attributes=>{
				      "user-name"=>"giftstart",
				      "session-name"=>"something",
				     },
			 children=>[]
			}
			,
			{
			 element=>"get-algorithms",
			 attributes=>{},
			 children=>[]
			}
			,
			{
			 element=>"get-collections",
			 attributes=>{},
			 children=>[]
			}
		       ]
	    };
  
  
  my $lSocket = IO::Socket::INET->new(PeerAddr => $lHost,
				      PeerPort => $lPort,
				      Proto    => 'tcp')
    or die "No socket to $lHost:$lPort\n";
  
  $lSocket->autoflush(1);
  my $lWriter=new CXMLTreeWriter();
  
  $lWriter->writeToStream($lTree,
			  $lSocket);
  $lSocket->shutdown(1);
  my $lRead="";
  
  while(<$lSocket>){
    $lRead.=$_;
  }
  
  print "READ:$lRead:READ";
  
  my $lBuilder=new CXMLTreeBuilder();
  my $lParsed=$lBuilder->stringToTree($lRead);
  
  print "The sessionID is : $lParsed->{attributes}->{'session-id'}\n";
  
  # very GENEVA SPECIFIC:  system("find /usr/local/httpd/htdocs/tutorial/ -name \"*.html.in\" -exec perl /home/wolfgang/configure-tutorial.pl $lParsed->{attributes}->{'session-id'} \{\} \\;");
  
}