#!/usr/bin/perl

# get_camera	K. J. Turner	04/01/19

# This script gets the current image from an IP camera into "image001.jpeg",
# shuffling all previous images up one place (015 -> 016, 014 -> 015, etc.).
# Thumbnail images like "image001s.jpeg" (suffix "s" for small) are also
# created. When it is noon, the current image (and its thumbnail) are archived
# in directory "archive". Images are created writable by the owner and
# readable by everyone.
#
# If getting an image fails, this is logged and a message is sent by email.

################################# Modules #################################

use Cwd;					# load current directory package
use Getopt::Std;				# load options package
use Authen::SASL;				# load SSL authentication
use IO::Socket::SSL;				# load SSL sockets
use Net::SMTP;					# load SMTP client
use Time::HiRes qw(time);			# use microseconds

############################### Main Program ##############################

&customise;					# customise script
&initialise;					# initialise script
&get_image;					# get camera image
&finalise;					# finalise script

############################### Subroutines ###############################

# archive current image as "imageYYMMDD[s].jpeg" if it is noon

sub archive_image {
  my($file1, $file2, $hour, $mday, $min,	# locals
     $mon, $rest, $sec, $year);

  ($sec, $min, $hour, $mday, $mon, $year, $rest) = # get time
    localtime(time);
  $mon++;					# get month 1..12
  $year += 1900;				# get year 1900..
  $year %= 100;					# get year YY
  if (($hour == 11 && $min > 50) ||		# after 11.50 or ...
      ($hour == 12 && $min < 10)) {		# before 12.10?
    $file1 = &get_name(0);			# get full image name
    $file2 = "$ARCHIVE/" .			# set "imageYYMMDD.jpeg"
      sprintf("%s%02d%02d%02d", $IMAGE_BASE, $year, $mon, $mday) .
      $JPEG_SUFFIX;
    $command = "cp -p $file1 $file2";		# set copy command
    &run($command);				# run move command
    $file1 =~					# get thumbnail filename
      s/$JPEG_SUFFIX/$THUMB_SUFFIX$JPEG_SUFFIX/o;
    $file2 =~					# get thumbnail filename
      s/$JPEG_SUFFIX/$THUMB_SUFFIX$JPEG_SUFFIX/o;
    $command = "cp -p $file1 $file2";		# set copy command
    &run($command);				# run move command
  }
}

# Return appropriate message depending on whether the camera or the router seems
# to be dead.

sub check_ports {
  my($camera_alive, $message, $router_alive);	# locals

  $message = "";				# initialise message
  $router_alive = &live_port($CAMERA_HOST, $ROUTER_PORT);
  if ($router_alive) {				# router alive?
    $camera_alive = &live_port($CAMERA_HOST, $CAMERA_PORT);
    if ($camera_alive) {				# camera alive?
      # $message = "The router and webcam are responding. " .
      #   "No action is needed.";
    }
    else {					# camera dead
      $message = "The router is responding, but the webcam is not. " .
	"Try switching the webcam off then on.";
    }
  }
  else {					# router dead
    $message = "The router is not responding. Try switching the router off " .
      "then on.";
  }
  return($message);				# return message
}

# customise script

sub customise {
  $ARCHIVE = "archive";				# set archive directory
  $AUTHOR = "XXX\@XXX";				# set email sender
  $CAMERA_HOST = "XXX.XXX";			# set default camera host
  $CAMERA_PORT = "XXX";				# set default camera port
  $CAMERA_URL = "http://$CAMERA_HOST:$CAMERA_PORT"; # set camera URL
  $CC = "XXX\@XXX";				# set secondary recipient
  $CREDS = "XXX";				# set email credemtials (passwd)
  $DEBUG = 0;					# set debugging level
  $ERROR_HOUR = 3;				# set hour modulus for errors
  $FROM = "\"XXX\" <$AUTHOR>";			# set sender
  $IMAGE_BASE = "image";			# set image base name
  $IMAGE_LIMIT = 16;				# set maximum number of images
  $IMAGE_MODE = oct("644");			# set image file mode
  $JAVA = "java";				# set Java command
  $JPEG_SUFFIX = ".jpeg";			# set JPEG suffix
  $ROUTER_PORT = "80";				# set router web port
  $SERVER = "XXX.XXX";				# set email server
  $SUBJECT = "WebCam Problem";			# set message subject
  $TELNET = "/usr/bin/telnet";			# set Telnet command
  $TELNET_LIMIT = 5;				# set Telnet limit (seconds)
  $THUMB_SUFFIX = "s";				# set thumbnail suffix
  $TO = "XXX\@XXX";				# set primary recipient
}

# report error

sub error {
  my($message) = @_;				# get error message

  &log("$program: $message");			# log error
  $exit_code = 1;				# set exit code of 1
  &finalise;					# exit script
}

# finalise script

sub finalise {
  exit($exit_code);				# exit with code
}

# return credentials

sub get_credentials {
  return($CREDS);
}

# get current camera snapshot into "image001.jpeg", renumbering later images by
# 1 but discarding anything beyond the limit

sub get_image {
  my($command, $file1, $file2, $highest, $name);# locals

  # &log("Getting image (host $host, time " . time . ")"); # log host and time
  for ($highest = $IMAGE_LIMIT; $highest; $highest--) { # go through numbers
    $name = &get_name($highest);		# get image filename
    if (-r $name) {				# image filename exists?
      last;					# leave loop
    }
  }
  $file1 = &get_name(0);			# get full image file name
  $command =					# set camera snapshot command
    "$JAVA GetCamera $opt_u $file1";
  &run($command);				# get snapshot
  if (!$exit_code && -r $file1) {		# no error and image obtained?
    &log("Success retrieving image");		# log image retrieval
    chmod($IMAGE_MODE, $file1);			# set full image file mode
    $file2 = $file1;				# set thumbnail image file name
    $file2 =~					# set thumbnail filename
      s/$JPEG_SUFFIX/$THUMB_SUFFIX$JPEG_SUFFIX/o;
    chmod($IMAGE_MODE, $file2);			# set thumbnail image file mode
    &archive_image;				# archive image (if appropriate)
    for ($i = $highest; $i >= 0; $i--) {	# from earliest to latest image
      if ($i < $IMAGE_LIMIT) {			# not at last image?
	$file1 = &get_name($i);			# get current image filename
	$file2 = &get_name($i + 1);		# get next image filename
	if (-r $file1) {			# old image file exists?
	  $command = "mv $file1 $file2";	# set rename command
	  &run($command);			# rename image file
	}
	$file1 =~				# get current thumbnail filename
	  s/$JPEG_SUFFIX/$THUMB_SUFFIX$JPEG_SUFFIX/o;
	$file2 =~				# get next thumbnail filename
	  s/$JPEG_SUFFIX/$THUMB_SUFFIX$JPEG_SUFFIX/o;
	if (-r $file1) {			# old thumbnail file exists?
	  $command = "mv $file1 $file2";	# set rename command
	  &run($command);			# rename thumbnail file
	}
      }
    }
  }
}

# return image filename for given image number, e.g. "image021.jpeg"

sub get_name {
  my($number) = @_;				# get image number

  return(sprintf("$IMAGE_BASE%03d$JPEG_SUFFIX", $number)); # return image name
}

# initialise script and options

sub initialise {
  $host = `hostname -f`;			# get fully-qualified hostname
  chop($host);					# remove trailing newline
  $program = $0;				# set program name
  $program =~ s/.*\///go;			# remove directories
  $directory = $0;				# set program name
  if (index($directory, "/") == -1 ||		# no directory or ...
      $directory =~ /^\.\//o) {			# in current directory?
    $directory = cwd();				# use current directory
  }
  else {					# in other directory
    $directory =~ s/\/[^\/]+$//o;		# remove program name
  }
  chdir($directory) ||				# change to directory or ...
    &error("Failure changing to directory '$directory'"); # log error
  $exit_code = 0;				# initialise exit code
  # $LOG_FILE = "$program$LOG_SUFFIX";		# set log file
  $opt_h = 0;					# set no help
  $opt_u = $CAMERA_URL;				# set default URL
  $usage =					# options wrong, help, args?
    !getopts('hu:') || $::opt_h || $#ARGV >= 0;
  if ($usage) {					# usage required?
    &usage;					# print usage
  }
}

# check if given host and port respond to Telnet, returning 1 if alive else
# 0 if dead

sub live_port {
  my($host, $port) = @_;			# get host and port
  my($command, $result, $time);			# locals

  &log("Checking host $host, port $port");	# log check attempt
  $command =					# set check command
    "$TELNET $host $port < /dev/null > /dev/null 2>&1";
  $time = time();				# get current time in seconds
  $result = system($command);			# get command result
  $time = time() - $time;			# get execution time in seconds
  return($time < $TELNET_LIMIT);		# 1 if short enough else 0
}

# log message

sub log {
  my($message) = @_;				# get message
  my($command, $email, $hour, $mday, $min,	# locals
     $mon, $rest, $sec, $year);

  ($sec, $min, $hour, $mday, $mon, $year, $rest) = # get time
    localtime(time);
  $mon++;					# get month 1..12
  $year += 1900;				# get year 1900..
  if ($message !~ /Failure/io) {		# non-failure message?
    $email = "";				# set no email for success
    # $email = $message;			# set email for success
  }
  else {					# failure message
    if (($hour % $ERROR_HOUR) == 0 && ($min < 10)) { # hour for error report?
      if ($message =~ /GetCamera/io) {		# camera failure?
	$email = &check_ports();		# get email for port status
      }
      else {					# not camera failure
	$email =				# set email
	  "General failure trying to get image - $message. This is a system " .
	  "problem that the developer needs to look into.";
      }
    }
  }
  if ($email) {					# email message to send?
    &send_email($email);			# send message by email
  }
  $message =					# set log message
   sprintf("%02d:%02d:%02d %02d/%02d/%04d %s",
      $hour, $min, $sec, $mday, $mon, $year, $message);
  system("echo \"$message\"");			# output log message
}

# run command, reporting any error

sub run {
  my($command) = @_;				# get command

  # &log("Running '$command'");			# log command
  if (system($command)) {			# command failed?
    &error("Failure running '$command'");	# log problem
  }
}

# send email for given message body

sub send_email {
  my($message) = @_;				# get message
  my($mailer, $sasl);				# locals

  $mailer = Net::SMTP->new(			# create SMTP client
    $SERVER, SSL => 1, Debug => $DEBUG) ||	# set server, SSL and debug
    &error("Failure connecting to SMTP server '$SERVER'"); # report error
  $sasl = Authen::SASL->new(			# create SSL authentication
    # mechanism => 'PLAIN',			# set authentication mechanism
    callback => {				# create authentication callback
      pass => \&get_credentials,		# get credentials
      user => $AUTHOR,				# define sender
      debug => $DEBUG				# set debug
    }
  );
  $mailer->auth($sasl) ||			# authenticate sender
    &error("Failure authenticating with SMTP server"); # report error
  $mailer->mail($AUTHOR);			# set sender
  $mailer->to($TO);				# set To address
  if ($CC) {					# Cc defined?
    $mailer->cc($CC);				# set Cc address
  }
  $mailer->data();				# start sending data
  $mailer->datasend(				# send data
    "To: $TO\r\n" .				# set To
    "From: $FROM\r\n" .				# set From
    "Subject: $SUBJECT\r\n\r\n" .		# set Subject
    $message . "\r\n");				# append message
  $mailer->dataend();				# finish sending data
  $mailer->quit();				# exit SMTP client
}

# print script usage

sub usage {
  print STDERR "usage: $program\n";
  print STDERR "  -h       " .
    "help on parameters\n";
  print STDERR "|\n";
  print STDERR "  -u [url] " .
    "camera URL (default $CAMERA_URL)\n";
  exit(1);
}
