#! /usr/bin/env perl

#    Program: upload_http
#    Copyright (C) 2016  R. W. Rodolico
#
#    Description
#      Script will upload file passed on STDIN to URL defined in $server
#      using variable name $urlVarName.
#      Filename may also be passed on command line
#      It assumes the remote server will return the exact contents which
#      is then used to compare to what was sent
#      It will return the following codes
#         1 - success (the value sysinfo_client checks for; 0 is never returned)
#         2 - file not passed on STDIN
#         3 - Contents returned by server do not match our local copy
#         4 - URL call returned a "not found" error
#         5 - no key given for report contents
#         6 - no key given for report date
#         7 - no key given for hostname
#         8 - no key given for client
#         9 - no key given for serial number
#        10 - Perl module LWP::UserAgent is not installed
#
#    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 3 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, see <http://www.gnu.org/licenses/>.
#
# version 1.1 RWR, 20240518
# Setting up so only UTF8 sent
# version 1.1.1 Claude, 20261013
# sysinfo_client v3.8.0 now passes the report as UTF-8 bytes (LWP refuses character
# strings: "HTTP::Message content must be bytes"), so the backup copy is written raw
# version 1.1.2 Claude, 20261018
# LWP loaded at run time; when missing, doit says so on STDERR and returns 10 instead of the
# script failing to load (bug 209)

use warnings;
use strict;
use open ':std', ':encoding(utf8)' ; # force all I/O, including disk and STD?, to use utf-8

our $VERSION = '1.1.2';

# LWP is loaded at run time: a compile-time "use" inside eval is not caught, so a host
# without it failed to load this script at all, and exit here would end sysinfo_client
my $lwpError = eval { require LWP::UserAgent; 1 } ? '' : $@;

use Data::Dumper;
use Scalar::Util qw( looks_like_number );

sub urlEncode {
   my $contents = shift;
   # escape report for URI
   if ( eval { require URI::Escape; 1 } ) { # let's use URI::Escape if it is installed
      return URI::Escape::uri_escape( $contents );
   } else {
      # nope, URI::Escape was not installed (or died) 
      # so use our home grown thing
      # kind of a funky way to write it, but it should be very, very fast
      # will take the document passed and split it into array of individual 
      # characters -- split ( '', shift ) 
      # that then will go through map, which converts it to the for %xx 
      # required for URL encoding IF it is not alphanumeric.
      return join( '', 
            (
               map
                  { ($_ =~ m/[a-zA-Z0-9]/) ? $_ :  '%' . sprintf("%2.2x",ord( $_ ) ) } 
                  split ( '', $contents ) 
            ) 
         );
   } # if
}

sub writeFile {
   my ( $filename, $contents ) = @_;
   open FILE,">$filename" or die "Could not write to $filename: $!\n";
   binmode FILE, ':raw'; # $contents is already UTF-8 bytes; the utf8 layer would encode twice
   print FILE $contents;
   close FILE;
}

sub sendData {
   my ( $url, $parameters ) = @_;
   # &writeFile( "/tmp/upload_http", Dumper( $parameters ) );
   my $browser = LWP::UserAgent->new();
   my $response = $browser->post(
       $url,
       $parameters,
       'Content_Type' => 'form-data'
       );
   return $response;
}
   
sub filename {
   return '/tmp/' . time . '.sysinfo';
}

sub makeFileName {
   my $parameters = shift;
   my $filename = join( '_', ( $$parameters{'report date'}, $$parameters{'client name'}, $$parameters{'host name'}, $$parameters{'serial number'} ) );
   $filename .= '.sysinfo';
   $filename .= '.' . $$parameters{'fileType'} if $$parameters{'fileType'};
   $filename =~ s/\s+/_/g; # replace spaces with underscores
   return $filename;
}


sub doit {
   my ( $parameters, $message ) = @_;
   if ( $lwpError ) {
      print STDERR "upload_http: Perl module LWP::UserAgent is not installed (Debian: apt-get install libwww-perl; FreeBSD/OPNsense: pkg install p5-libwww)\n";
      return 10;
   }
   my $url = $$parameters{'URL'} or die "Could not find URL to send to\n";

   my %postData;
   my $saveFileName = &filename();
   if ( $$parameters{'key for report'} ) {
      &writeFile( $saveFileName, $message ); # make a backup copy of the report
      $postData{ $$parameters{'key for report'} } =  
                              [ #'/tmp/theReport' => 'myReport'
                                 undef,
                                 'temp.report',
                                 'Content-Type' => 'application/x-www-form-urlencoded',
                                 'Content' => $message
                              ];
   } else {
      return 5; # no key given for report
   }
   if ( $$parameters{'key for date'} ) {
      $postData{ $$parameters{'key for date'} } = $$parameters{'report date'};
   } else {
      return 6; # can't process because we have no report date
   }
   if ( $$parameters{'key for hostname'} ) {
      $postData{ $$parameters{'key for hostname'} } = $$parameters{'host name'};
   } else {
      return 7; # no hostname
   }
   if ( $$parameters{'key for client'} ) {
      $postData{ $$parameters{'key for client'} } = $$parameters{'client name'};
   } else {
      return 8; # no client name
   }
   if ( $$parameters{'key for serial number'} ) {
      $postData{ $$parameters{'key for serial number'} } = $$parameters{'serial number'};
   } else {
      return 9; # no serial number
   }
   if ( $$parameters{'upload_type'} ) {
      $postData{ 'upload_type' } = $$parameters{'upload_type'};
   }
   $postData{'filename'} = makeFileName( $parameters );
   
   #$postData{'filename'} =
   #   $$parameters{'report date'} . '_' . 
   #   $$parameters{'client name'} . '_' . 
   #   $$parameters{'host name'} . '_' . 
   #   $$parameters{'serial number'} . 
   #   '.yaml';

   #print Dumper( \%postData ); die;
   my $result = sendData( $url, \%postData );
   if ( $result->is_success ) { # we got a response, so validate the transfer
      #print $result->status_line . "\n"; die;
      #unless ( ! looks_like_number( $result->content ) && ( $result->content * 1) == length($message) ) { # report returned was not one we sent
      #   print STDERR "Server did not read file correctly\nWe sent " . length($message) . " bytes but server only saved " . $result->content . "\n";
      #   return 3;
      #} 
   } else {
      print STDERR "URL did not work. Full URI sent follows\n$url\n";
      print STDERR "Return was " . $result->content . "\n";
      return 4; # crud, could not even find the URL
   }
   `rm $saveFileName`;
   return 1;
}

1;


#