package RFC::Main;
#$Id: Main.pm,v 1.101 2025/07/28 07:01:19 sqko Exp $
use strict;
use warnings;
use RFC::Header;
use RFC::Spline;
use SocketClient;
use SemaforeFile;
use ElchemeaConfig;
use IO::Socket::INET;
use IO::Interface::Simple;
use Sys::Hostname;
use CGI qw(:standard :netscape);
use Crypt::OpenSSL::Random;
use Crypt::OpenSSL::RSA;
use Crypt::CBC;
use LWP::UserAgent;
use URI::Escape;
use MIME::Base64;
use SOAP::Lite;
use Data::Dumper;
use Net::Ping;
use IO::Socket::SSL;
use Email::Sender::Simple qw(sendmail);
use Email::MIME;
use IO::All;
use File::MimeInfo;
### Allow self signed cert hack
if (-e '/home/celltest/allow_selfsigned_certs')
{
    IO::Socket::SSL::set_defaults(SSL_verify_mode => 0);
      $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0;
}
### End self signed cert hack

#################################################################
#
#  Package RFC::Main
#
#
# This module exports a number of utility functions used by both 
# the user interface, but also by some of the other modules supplied
# by RFCcontrol.
#
# The functions exported by default are
#
# -- \begin{longtable}{l p{12cm}}
# -- CGI_client($@) & Client program for communication with the different CGI-servers for the rigs attatched to the system. The first argument must be a rig name, and any additional arguments are passed to the CGI-server. \\
# -- errorlog() & Writes any arguments to the errorlog (usually /home/celltest/errorlog.txt) \\
# -- get_cv($$) & returns a configuration value obtained from the global configuration file (usually /home/celltest/conf/celltest_global.conf). Arguments: section and key. If called in a list context it returns the value as an array split along any commas (ignres spaces before and after the commas). If no matching key or no value is returned default values may be returned instead. \\
# -- print_error() & Prints any error information incapsulated in appropriate html tags. If an argument is specified, that is displayed, if not, the last string appended to the error file is displayed instead. \\
# -- get_error() & Returns the last string appended to the error file. \\
# -- \end{longtable}
# 
# Additionally, the following functions are also avaliable through 
# explicit function call.
#
#
# -- \begin{longtable}{l p{11cm}}
# -- get_cv_default($$) & Returns the default value for the specified kay - value pair. Returnes undef if no default value is defined. \\
# -- config() & Returns a ElchemeaConfig instance of the global configuration file \\
# -- get_uicfg($$) & returns a configuration value obtained from the user interface configuration file (usually /home/celltest/conf/UI.cfg). Arguments: section and key. Note this function is deprecated and should not be used from 7.3.0 onwards as it will be removed at a future date. \\
# -- get_rigs() & Returns a list of valid rigs on the server \\
# -- get_servers() & Returns a list of known servers (obtained form global configuration file). \\
# -- get_user_name($) & Returns the user name from a given userid (note only usable from local password server). \\
# -- check_rig_nr($) & Returns 1 if the rig specified is a valid rig 0 otherwise. \\
# -- spline($$) & Returns the splineinterpolated value based on filename specifying a file containing the interpoation table and the value to interpolate. Arguments: filename and value. \\
# -- spline_user_files() & Returns a list of valie filenames for spline interpolation. The list is defined as the files found in the splineinterpolation directory (usually /home/celltest/convert-table/userfiles/) \\
# -- passwd_client(@) & Returns the response from the password server when queried with the specified arguments. \\
# -- passwd_client_raw($$@) & Same as password_client, but the hostname and port number must be specified as the first 2 arguments (before the real arguments passed on to the password server). \\
# -- mail($$[$]) & Sends an email to the specified email address with the specified message. An optional third argument will be used as subject. Arguments: address, message, [subject]. \\
# -- mail_att($$$[$]) & Sends an email to the specified email address with the specified message. The third argument will be used as subject. Any further arguemnts are assumed to bi filenames to be attatched to the email. Arguments: address, message, subject [files]. \\
# -- get_gasses() & Returns a list of gasses for for which the gas factor is known. \\
# -- get_soap() & Returns the soap interface object (if a SOAP interface is used for the password subsystem) \\
# -- remote_system_log($) & Appends the supplied string to the remote logbook. The call is made by calling the url specified in the 'logbook_url' key in the global section of the main configuration file appended with the supplied string (which will be url-encoded). Thus if the logbook_url contains 'https://foo.bar/cgi-bin/log.cgi?id=342\&msg=' and the function is called woth the string 'test_msg' the resulting url called will be:  https://foo.bar/cgi-bin/log.cgi?id=342\&msg=Test_msg \\
# -- \end{longtable}
#
#################################################################


BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    @EXPORT_OK = qw(CGI_client errorlog get_cv print_error get_error get_soap);
    %EXPORT_TAGS = (
        'standard'=>[qw/errorlog get_cv CGI_client print_error get_error/],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}




my $config = ElchemeaConfig->new($configfile,$configlock);
# Note cfg below is depredated!
my $cfg = ElchemeaConfig->new($RFC::Header::uicfg,$configlock);

### Fix for broken SSL chainfiles ###
my $chainfile = &get_cv('SSL','chainfile');
if($chainfile)
{
    $ENV{HTTPS_CA_FILE}   = $chainfile;
}


my $remote  = 'localhost';
my $ip = inet_ntoa(inet_aton($remote));
my $ssl_lock = $RFC::Header::homedir.'ssl.lock';
my $pubfile = SemaforeFile->new($RFC::Header::homedir.'public.key',$ssl_lock);
my $prifile = SemaforeFile->new($RFC::Header::homedir.'secret.key',$ssl_lock);
my $known = SemaforeFile->new($RFC::Header::homedir.'known_hosts',$ssl_lock);
unless ($known->exist)
{
    $known->chmod(0666);
}
my $ssl = undef;
my $str = &get_cv('passwds','force_encryption');
$ssl = 1 if ($str && $str =~ /yes/i);
my $force_ssl = $ssl;

unless ($prifile->exist)
{
    my $rsa = Crypt::OpenSSL::RSA->generate_key(2048);
    $pubfile->writeline($rsa->get_public_key_string());
    $prifile->writeline($rsa->get_private_key_string());
    chmod 0640,$prifile->filename();
}
my $rsa_pub = Crypt::OpenSSL::RSA->new_public_key(join("\n",$pubfile->readlines()));
my $rsa_priv = undef;
## Setup hash for key management ###
my %keys = ($ip=>$rsa_pub);
&load_known_hosts();

my $service  = &get_cv('passwds','passwd_server');
my $soap;
my $soap_ignore = 0;
$soap_ignore = 1 if (&get_cv('passwds','ignore_soap') && &get_cv('passwds','ignore_soap') =~ /yes/i);
my $soap_errnr = 0;
our @SOAP_ERRORS = ();

our %report_soap = ();


return 1;

sub get_soap()
{
    return $soap;
}

sub load_soap()
{
    return 1 if ($soap);
    return 0 if ($soap_ignore || $service =~ /localhost/i);
    my $res = 0;
    if ($service)
    {
	eval {
	    my $wsdl = &get_cv('passwds','wsdl');
	    $wsdl = 'https://'.$service.'/wsdl/session.wsdl' unless ($wsdl);
	    $soap = SOAP::Lite->on_fault(\&soapGetBad)->service($wsdl);
	    my $host = $soap->ping();
	    if ($host)
	    {
		$res = 1;
	    }
	    else
	    {
		$soap = undef;
	    }
	};
	if ($@)
	{
	    warn $@;
	    ## Allow silent soap error for fallback ##
	    $soap = undef;
	    $soap_ignore = 1;
	}
    }
    return $res;
}

sub is_soap_error()
{
    return 0 if ($soap_errnr == @SOAP_ERRORS);
    $soap_errnr = @SOAP_ERRORS;
    return $soap_errnr;
}

sub soapGetBad {
    my $soap = shift;
    my $res = shift;
    if( ref( $res ) ) {
        chomp( my $err = $res->faultstring );
        push( @SOAP_ERRORS, "SOAP FAULT: $err" );
	&errorlog("SOAP FAULT: $err");
    }
    else {
        chomp( my $err = $soap->transport->status );
        push( @SOAP_ERRORS, "TRANSPORT ERROR: $err" );
	&errorlog("TRANSPORT ERROR: $err" );
    }
    return new SOAP::SOM;
}



sub remote_system_log($)
{
    my $msg = shift;
    my $url = get_cv('global','logbook_url');
    return undef unless ($url && defined($msg));
    $msg = uri_escape($msg);
    my $ua = LWP::UserAgent->new();
    $ua->timeout(60);
    my $query = $url.$msg;
    my $request = new HTTP::Request('GET',$query);
    my $response = $ua->request($request);
    if ($response->is_success)
    {
	return $response->content;
    }
    else
    {
	&errorlog("Error contacting $url: ".$response->status_line);
	return 0;
    }
}

sub get_rsa_priv()
{
    if (defined($rsa_priv))
    {
	return $rsa_priv; 
    }
    $rsa_priv = Crypt::OpenSSL::RSA->new_private_key(join("\n",$prifile->readlines()));
    return $rsa_priv;
}


sub load_known_hosts()
{
    my $state = 0;
    my @list = ();
    my $host_name = '';
    foreach my $line ($known->readlines())
    {
        if ($state)
        {
            if ($line =~ /^\s*$/)
            {
                $state = 0;
                $keys{$host_name} = Crypt::OpenSSL::RSA->new_public_key(join("\n",@list));
                next;
            }
            push @list,$line;
            next;       
        }
        next if ($line =~ /^\s*$/);
        @list = ();
        $host_name = $line;
        $state = 1;
    }
}

sub config()
{
    return $config;
}

sub get_uicfg($$)
{
    ## Note hits function is deprecated!
    return $cfg->get_config_value(@_);
}

sub get_cv_default($$)
{
    return undef unless (exists($RFC::Header::default_conf{$_[0]}));
    return undef unless (exists($RFC::Header::default_conf{$_[0]}{$_[1]}));
    return $RFC::Header::default_conf{$_[0]}{$_[1]};
}

sub get_cv($$)
{
    my $val = $config->get_config_value(@_);
    $val = &get_cv_default(@_) unless (defined($val));
    if (wantarray)
    {
	return () unless (defined($val));
	my @list = split(/\s*\,\s*/,$val);
	return @list;
    }
    return $val;
}

sub get_gasses()
{
    return $config->get_keys('gas');
}


sub get_rigs()
###################################################################
#### Returns the rigs on the specified server, if no server is  ###
#### specified the function returns the rigs on THIS server     ###
###################################################################
{
    my @rigs = ();
    if (@_)
    {
	my $str = get_cv('celltest','rigs_'.shift);
        @rigs = split(/\s*\,\s*/,$str) if ($str);
    }
    else
    {
	my $str = get_cv('celltest','rigs');
        @rigs = split(/\s*\,\s*/,$str) if ($str);
    }
    return @rigs;
}

sub get_servers()
######################################################################
#### Returns the servers specified in the global configuration file ##
######################################################################
{
    my $str = &get_cv('celltest','servers');
    return () unless ($str);
    return split(/\s*\,\s*/,$str);
}

sub get_user_name($)
############################################
### Returns the username crresponding to ###
### a given userid                       ###
############################################
{
    my $uid = shift;
    my $name = undef;
    open PASS , '<' , '/etc/passwd' or die &errorlog("Could not open /etc/passwd for reading!");
    while (my $line = <PASS>)
    {
	next unless ($line =~ /x:$uid:/);
	$line =~ /^(\w+):/;
	$name = $1;
    }
    close PASS;
    return $name;
}

sub check_rig_nr($)
###########################################################
###  Checks if the specified rig exsists on this server ###
###########################################################
{
    my $rig = shift;
    my @rigs = &get_rigs();
    for my $trig (@rigs)
    {
        return 1 if ($rig == $trig);
    }
    &errorlog("Rig '$rig' not valid!");
    return 0;
}

sub spline_user_files()
##################################################################
#  Function returning the files in the userdirectory for spline  #
#  interpolation                                                 #
##################################################################
{
    my $dir = $homedir.'convert-tables/userfiles/';
    return () unless (-d $dir);
    opendir MYDIR,$dir or die &errorlog("Could not open directory $dir $!");
    my @list = grep !/^\.\.?$/, readdir MYDIR;
    closedir MYDIR;
    foreach (@list)
    {
	chomp;
    }
    return @list;
}


sub spline($$)
##################################################################
### Function doing a spline interpolation of $value into the   ###
### specified in $file                                         ###
##################################################################
{
    my $file = shift;
    my $value = shift;
    if ($file && $file =~ /([\w\.\-\/]+)/)
    {
	$file = $1;
    }
    else
    {
	return undef;
    }
    if (defined($value) && $value =~ /([\d\.\-\+eE]+)/)
    {
	$value = $1;
    }
    else 
    {
	return undef;
    }
    my $f = $homedir.'convert-tables/'.$file;
    if ($f && -e $f)
    {
	open SPMYIN,'<',$f or die "Could not open file $f for reading $!\n";
	my @data = <SPMYIN>;
	close SPMYIN;
	my $spline = RFC::Spline->new(join('',@data));
	my $res = $spline->value($value);
	return $res;
    }
    return undef;
}

sub get_error()
{
    my $file = $homedir.'error.txt';
    my $lock = $homedir.'error.lock';
    my $e = SemaforeFile->new($file,$lock);
    $e->open_readback;
    my @list = ();
    my $str = $e->readline;
    push @list,$str;
    while ($str && $str !~ /^[\w\s]+\:/ )
    {
	$str = $e->readline;
	push @list,$str
    }
    $e->close;
    return join("\n",reverse(@list));
}

sub print_error()
{
    my $errstr = get_error();
    if ($errstr =~ /^(.*)\s+\#{4} Stack/s)
    {
	$errstr = $1;
    }
    print h1({-class=>'Alert'},"Errorcode:");
    print h3(escapeHTML($errstr));

}

sub errorlog($)
##################################################################
### Function which writes the input string to the errorlog    ####
##################################################################
{
    my $string = shift;
    chomp $string;
    warn $string,"\n";
    my $file = $homedir.'error.txt';
    my $lock = $homedir.'error.lock';
    my $e = SemaforeFile->new($file,$lock);
    my $time = localtime;
    my $st =  $time." : ".$string;
    #######################################
    ## Getting complete stack backtrace ###
    #######################################
    my @trace = ();
    my $i = 0;
    while(my ($package,$filename,$line,$subroutine) = caller($i++))
    {
        unshift @trace,"'$filename' line $line called $subroutine";
    }
    my $stacktrace = join(' -> ',@trace);
    $st .= ' #### Stack backtrace: '.$stacktrace;
	$e->append($st);
    return "$string (stacktrace logged in $file)";
}


sub CGI_client($@)
{
    my $remote = '';
    my @ilst = ('eth','em','en','lo');
    my @ifl = IO::Interface::Simple->interfaces();
  OUTER:
    foreach my $try (@ilst)
    {
        foreach my $interface (@ifl)
        {
            if ($interface =~ /$try/)
            {
                my $if = IO::Interface::Simple->new($interface);
                $remote = $if->address();
                last OUTER if ($remote);
            }
        }
    }
    my $rig = shift;
    my $port    =  get_cv('global','CGI_baseaddress')+$rig;
    return SocketClient::socket_client($remote,$port,@_);
}

sub report_client_soap()
{
    my $remote  = shift;
    if ($remote && $remote =~ /([\w\.\-\/\:]+)/)
    {
	$remote = $1;
    }
    else
    {
	return '';
    }
    ## Check if server is reachable ###
    my $p = Net::Ping->new("tcp", 2);
    $p->port_number(scalar(getservbyname("https", "tcp")));
    my $is_alive = $p->ping($remote);
    $p->close();
    return undef unless ($is_alive);
    ## Get data ##
    my $wsdl = 'https://'.$remote.'/wsdl/report.wsdl';
    my $res;
    eval {
	my $fn = shift;
	unless ($report_soap{$remote})
	{
	    $report_soap{$remote} = SOAP::Lite->on_fault(\&soapGetBad)->service($wsdl);
	}                      
	$res = $report_soap{$remote}->$fn(@_);                                                                                
    };
    if ($@)
    {
	warn $@;
	$res = 'SOAP_ERROR';
    }
    return $res;
}

sub report_client(@)
{
    my $res;
    unless (&get_cv('passwds','ignore_soap') && &get_cv('passwds','ignore_soap') =~ /yes/i)
    {
	## Try SOAP first ##
	$res = &report_client_soap(@_);
	return $res if (!defined($res) || $res ne 'SOAP_ERROR');
	## Fallback to normal report client
    }
    my $remote  = shift;
    my $port    = 4040;
    my $result;
    my $ssl_rep = 0;
    eval {
	$ssl_rep = $force_ssl;
	unless ($ssl_rep)
	{
	    my $out = SocketClient::socket_client($remote,$port,'is_ssl');
	    if ($out && $out == 1)
	    {
		$ssl_rep = 1;
	    }
	}
        if ($ssl_rep && !$keys{$remote})
        {
            $known->lock_ex;
            &load_known_hosts();
            unless ($keys{$remote})
            {
                ### Load remote public key i not cached ###
		my $str = SocketClient::socket_client($remote,$port,'public_key');
                if ($str && $str =~ /RSA/)
                {
                    $keys{$remote} = Crypt::OpenSSL::RSA->new_public_key($str);
                    $known->append($remote,$str,'');
                }
            }
            $known->lock_un;
        }
	if ($ssl_rep)
	{
	    my $res = '';
	    if ($keys{$remote})
	    {
		my $str = join("\t",@_);
		$str = ' ' unless (defined($str) && length($str) > 0);
		if (length($str) > 32)
		{
		    my @chars = ('A'..'Z', 'a'..'z','0'..'9','_');
		    my $key = '';
		    $key .= $chars[rand @chars] for 1..32;
		    my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
		    my $enc_str = encode_base64($cipher->encrypt($str));
		    my $enc_key = encode_base64($keys{$remote}->encrypt($key));
		    ### Transmit request as base64 encoded RSA encrypted AES key followed by an underscore ###
		    ### and then the base64 encoded AES encrypted request string                           ###
		    my $req_str = $enc_key.'_'.$enc_str;
		    $res = SocketClient::socket_client($remote,$port,$req_str);
		}
		else
		{
		    ### for short strings: Transmit request as base64 encoded RSA encrypted request string ###
		    $str = $keys{$remote}->encrypt($str);
		    $str = encode_base64($str);
		    $res = SocketClient::socket_client($remote,$port,$str);
		}
	    }
	    else
	    {
		my $str = "Warning: No encryption key found for '$remote', aborting!\n";
		&errorlog($str);
		return undef;
	    }
	    if (!$res || $res =~ /ERROR:/ )
	    {
		### Detect errors from socket client call ### 
		$res = 'No response!' unless (defined($res) && $res =~ /\w/);
		die $res;
	    }
	    elsif ($res && $res =~ /([\w\+\/\n\s\=]+)_([\w\+\/\s\n\=]+)/m)  
	    {
		### Detect underscore in result string and process accordingly ###
		### UseRSA and AES if underscore was found ###
		my $enc_key = $1;
		my $enc_cmd = $2;
		my $key = get_rsa_priv()->decrypt(decode_base64($enc_key));
		### Detaint key before use ###
		$key =~ /(\w+)/;
		$key = $1;
		my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
		$result = $cipher->decrypt(decode_base64($enc_cmd));
	    }
	    elsif ($res && $res =~ /\w+/)
	    {
		### use only RSA if no underscore in result ###
		$result = get_rsa_priv()->decrypt(decode_base64($res));
	    }
	    else
	    {
		$result = '';
	    }
	}
	else
	{
	    $result = SocketClient::socket_client($remote,$port,@_);
	}
	## Hack as encrypting a empty string or undef results in giberish ##
        ## Server returns an encrypted space if no result from query      ##
	$result = '' if ($result && $result eq ' ');  
    };
    if ($@)
    {
        $known->lock_un;
        &errorlog($@);
        return undef;
    }
    return $result;
}

sub passwd_client(@)
{
    my $remote  = get_cv('passwds','passwd_server');
    my $port    = get_cv('passwds','passwd_server_port');
    ## First try soap ##
    if (&load_soap())
    {
	my $res;
	my $fn = shift;
	eval {
	    $res = $soap->$fn(@_);
	};
	if ($@)
	{
	    warn $@;
	    $res = passwd_client_raw($remote,$port,$fn,@_);
	}
	return $res;
#	return $res unless (&is_soap_error());
    }
    ## Fallback to normal passwd server communication ##
    return passwd_client_raw($remote,$port,@_);
}

sub passwd_client_raw(@)
{
    my $remote = shift;
    my $port = shift;
    my $result;
    eval {
        unless (defined($ssl))
        {
	    my $out = SocketClient::socket_client($remote,$port,'is_ssl');
	    if ($out && $out == 1)
	    {
		$ssl = 1;
	    }
            else
            {
                $ssl = 0;
            }
	}
        if ($ssl && !$keys{$remote})
        {
            $known->lock_ex;
            &load_known_hosts();
            unless ($keys{$remote})
            {
                ### Load remote public key i not cached ###
		my $str = SocketClient::socket_client($remote,$port,'public_key');
                if ($str && $str =~ /RSA/)
                {
                    $keys{$remote} = Crypt::OpenSSL::RSA->new_public_key($str);
                    $known->append($remote,$str,'');
                }
            }
            $known->lock_un;
        }
	if ($ssl)
	{
	    my $res = '';
	    if ($keys{$remote})
	    {
		my $str = join("\t",@_);
		$str = ' ' unless (defined($str) && length($str) > 0);
		if (length($str) > 32)
		{
		    my @chars = ('A'..'Z', 'a'..'z','0'..'9','_');
		    my $key = '';
		    $key .= $chars[rand @chars] for 1..32;
		    my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
		    my $enc_str = encode_base64($cipher->encrypt($str));
		    my $enc_key = encode_base64($keys{$remote}->encrypt($key));
		    ### Transmit request as base64 encoded RSA encrypted AES key followed by an underscore ###
		    ### and then the base64 encoded AES encrypted request string                           ###
		    my $req_str = $enc_key.'_'.$enc_str;
		    $res = SocketClient::socket_client($remote,$port,$req_str);
		}
		else
		{
		    ### for short strings: Transmit request as base64 encoded RSA encrypted request string ###
		    $str = $keys{$remote}->encrypt($str);
		    $str = encode_base64($str);
		    $res = SocketClient::socket_client($remote,$port,$str);
		}
	    }
	    else
	    {
		my $str = "Warning: No encryption key found for '$remote', aborting!\n";
		&errorlog($str);
		return undef;
	    }
	    ### Detect underscore in result string and process accordingly ###
	    if ($res && $res =~ /([\w\+\/\n\s\=]+)_([\w\+\/\s\n\=]+)/m)
	    {
		### UseRSA and AES if underscore was found ###
		my $enc_key = $1;
		my $enc_cmd = $2;
		my $key = get_rsa_priv()->decrypt(decode_base64($enc_key));
		### Detaint key before use ###
		$key =~ /(\w+)/;
		$key = $1;
		my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
		$result = $cipher->decrypt(decode_base64($enc_cmd));
	    }
	    elsif ($res && $res =~ /\w+/)
	    {
		### use only RSA if no underscore in result ###
		$result = get_rsa_priv()->decrypt(decode_base64($res));
	    }
	    else
	    {
		$result = '';
	    }
	}
	else
	{
	    $result = SocketClient::socket_client($remote,$port,@_);
	}
	## Hack as encrypting a empty string or undef results in giberish ##
        ## Server returns an encrypted space if no result from query      ##
	$result = '' if ($result && $result eq ' ');
    };
    if ($@)
    {
        $known->lock_un;
        &errorlog($@);
        return undef;
    }
    return $result;
}

sub mail
######################################################################
### This munction sends a mail to $user with the message $message  ###
### Usage: &mail($user,$message,[opt subject]);                    ###
### The subject is "System mail from [name] on [hostname]" unless  ###
### it is specified as the third argument to mail()                ###
### If a fourth argument is specified it is assumed to be the      ###
### sender of the mail (the from field)                            ###
### The function returns 1 if successfull 0 otherwise              ###
######################################################################
{
    my $adr = shift;
    my $meas = shift;
    my $name = $RFC::Header::COPYRIGHT.' fuel cell test facility';
    my $hostname = hostname;
    my $s = "System mail from $name on $hostname";
    $s = shift if (@_);
    my $user = getlogin;
    $user = 'RFCcontrol' unless ($user);
    my $from = $user.'@'.$hostname;	
    $from = shift if (@_);
    eval {
	my @emails = ();
	if (ref($adr) eq 'ARRAY')
	{
	    @emails = @{$adr};
	}
	else
	{
	    @emails = ($adr);
	}
	my $email = Email::MIME->create(
	    header_str => [
		From => $from,
		To => [ @emails ],
		Subject => $s,
	    ],
	    attributes => {
		encoding => 'quoted-printable', 
		charset      => 'UTF8',
	    },
	    body_str => $meas
	    );
	sendmail($email);
    };
    if ($@)
    {
        &errorlog($@);
        return 0;
    }
    return 1;
}


sub mail_att
######################################################################
### This munction sends a mail to $user with the message $message  ###
### Usage: &mail($user,$message,[opt subject]);                    ###
### The subject is third argument to mail_att()                    ###
### Any further arguments are assumed to be filenames to be        ###
### attatched                                                      ###
### The function returns 1 if successfull 0 otherwise              ###
######################################################################
{
    my $adr = shift;
    my $meas = shift;
    my $name = $RFC::Header::COPYRIGHT.' fuel cell test facility';
    my $hostname = hostname;
    my $s = shift;
    my $user = getlogin;
    $user = 'RFCcontrol' unless ($user);
    my $from = $user.'@'.$hostname;	
    eval {
        my @parts = ();
        my $email = Email::MIME->create(
            attributes => {
                encoding => 'quoted-printable',
                charset      => 'UTF8',
            },
            body_str => $meas
            );
        push @parts,$email;
        my @files = ();
        while (my $filepath = shift)
        {
            next unless ($filepath);
            my $mime = mimetype($filepath);
            my $nameoffile = $filepath;
            $nameoffile =~ s/.*\///; # eat path of filename
            my $part = Email::MIME->create(
                attributes => {
                    content_type => $mime,
                    filename     => $nameoffile,
                    encoding     => "base64",
                    name         => $nameoffile,
                    attatchment => "attachment",
                },
                body => io( $filepath )->binary->all,
                );
            push @parts,$part;
        }
	my @emails = ();
	if (ref($adr) eq 'ARRAY')
	{
	    @emails = @{$adr};
	}
	else
	{
	    @emails = ($adr);
	}
	my $sender = Email::MIME->create(
	    header_str => [
		From => $from,
		To => [ @emails ],
		Subject => $s,
	    ],
	    parts => [ @parts ],
	    );
	sendmail($sender);
    };
    if ($@)
    {
        &errorlog($@);
        return 0;
    }
    return 1;
}

