#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Long;
use File::Basename;
use File::Spec;
use MIME::Base64;
use LWP::Simple;

my $vers = 'v.0.8';

=head1  

uudecode.pl (C) Stas Mishchenkov 2:460/58.

It is for simple decoding of any UU and BASE64 encoded files.

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.

The source file can be not only plain text, but also contain binary data. For example, it could be a message base file. All files encoded in it will be found and decoded.

It is possible to set the name of the log file and then a report on decoded files will be generated. Since the program is focused on using primarily for Fido, that is, the ability to set the name of the echo conference. It will be reflected in the log file and the decoded files will be placed in a separate directory with this name.

In addition, this program can independently check and download its own updates, but not apply them, leaving the decision to update to the system operator.


Usage:


  uudecode.pl [options] uuencoded_file_name


Options:

         --overwrite[|-o]  - overwrite existing files. By default, the
                             existing file is skipped, not overwritten.
                             This is convenient, for example, to decode
                             only new files from the echo conference.
         --decode-to[|-d]  - directory where to put decoded files.
                             By default, this will be the same directory
                             where the filecode.pl is located or the
                             current directory, if the operating system
                             does not allow to determine from where
                             uudecode.pl started.
         --area-name[|-a]  - echo area name. Allows you to set the name
                             of the echo conference. It will be used for
                             the report file. Also, a directory with the
                             same name will be created in the decode-to
                             directory and decoded files will be placed
                             in. By default, this will be DECODED.FILES.
         --log[|-l]        - log file name. Report file name. Not
                             maintained by default.
         --update[|-u]     - check for updates. Check for a new version
                             of the program. If there is a new version,
                             the program will be updated automatically.
                             By default, a new version is checked, the
                             update is downloaded but not installed.
         --no-update[|-n]  - do not check for updates. Useful for manual
                             start to speed up work.
                             By default, a new version is checked, the
                             update is downloaded but not installed.
                             It makes no sense to use the --update [|-u]
                             and --no-update [|-n] options at the same time.


=cut

my ($uuefile, $mtext, $size, $usage, $overwrite, $decodeto, $areaname,
	$logfile, %config, $check_updates, $no_check_updates );


sub usage
{
    File::Spec->rel2abs( __FILE__ ) =~ /.*[\\\/]([^\\\/]+)$/;
    print <<USAGE;

Usage:
~~~~~~
  $1 [options] uuencoded_file_name

Options:
         --overwrite[|-o]  - overwrite existing files
         --decode-to[|-d]  - directory where to put decoded files
         --area-name[|-a]  - echo area name
         --log[|-l]        - log file name
         --update[|-u]     - check for updates
         --no-update[|-n]  - no check for updates

	 For more details use perldoc uudecode.pl

USAGE
   exit 1;
}

sub writelog($)
{
    my ( $str ) = @_ ;
    if ( defined($logfile) )
    {
        if ( open( FLOG, ">>$logfile") )
        {
            print( FLOG "$str\n");
            close( FLOG );
        }
        else
        {
            print(STDERR "Can't open $logfile. ($!)\n");
        }
    }
}


sub catfile
{
    return File::Spec->catfile(@_);
}

sub prety_size($)
{
	my ( $fs ) = @_;
	if ( $fs >= 1048576 ) {
		return sprintf( "%.3f Mb", $fs/1048576 );
	}elsif ($fs >= 1024) {
		return  sprintf( "%.3f kb", $fs/1024 );
	} else {
		return  sprintf( "%d b", $fs );
	}
}


sub uu_decode($;$$)
{
	my ( $marea, $uuedir, $overwrite ) = @_;
	my ( $uudecoded_data, @uuelines, $decdir, $ofile,
		$filesize, $totalsize, $encoded_data );

	if ( defined($uuedir) ){
		if ($uuedir =~ /(.*)[\\\/]$/){
			$uuedir = $1;
		}
	}
	my ($i, $d) = (0, $uuedir);
	while ( -e $uuedir && !-d $uuedir) {
		$uuedir = sprintf( "$d\.%04x", $i);
		$i++;
		if ($i >= 65535) { # maximum files for FA32 file system.
			w_log("So may files \"$uuedir\".") if defined($config{protInbound});
			print STDERR "So may files \"$uuedir\".\n";
			return 1;
		}
	}
	mkdir $uuedir if !-e $uuedir;
        # директория, в которой складывать разююки.
	$i = 1;
	$totalsize = 0;
	my $files = 0;
	$decdir = catfile( $uuedir, uc($marea) );
	mkdir $decdir if !-e $decdir;
	while ( $mtext =~ /[\r\n]*begin \d+\s+([^\r\n]+)[\r\n]+([^ ]*?[\r\n]+)end[\r\n]+/i ){
	    @uuelines = split(/\r\n?/,$2);
#	    print "   found \'$1\'\n";
	    $ofile = catfile( $decdir,  $1 );
	    $mtext =~ s/[\r\n]*begin \d+\s+([^\r\n?]+)[\r\n]+[^ ]*?[\r\n]+end[\r\n]+/\r\n/i;
	    next if !$overwrite && -e $ofile;
	    if (open(F, ">$ofile")){
		binmode(F);
		foreach my $val ( @uuelines ){
		    $uudecoded_data = unpack("u", $val);
		    print(F $uudecoded_data) if defined $uudecoded_data;
		}
		close(F);
		$filesize = -s $ofile;
		$totalsize += $filesize;
#		print "   decoded $1\n";
		writelog(" $1 \(".sprintf( "% 11s", prety_size( $filesize ) )."\) from $marea");
		undef @uuelines;
		$#uuelines = -1;
		undef $uudecoded_data;
#		undef $val;
		$i = 0;
		$files++;
	    } else {
		print STDERR "Can't open \"$ofile\"\: $!\.\n";
		writelog("Can't open \"$ofile\"\: $!\.");
	    }
	}

	my $b64fn;
	while ( $mtext =~ /\r\n?Content\-type\: [^\r\n]+\; name\=\"([^\r\n]+)\"\r\n?Content\-transfer\-encoding\: base64\r\n?[\r\n]*([A-Z0-9\+\/\=\r\n]+)/i ){
	    $b64fn = $1;
	    $encoded_data = $2;
	    $ofile = catfile( $decdir, $b64fn );
	    $mtext =~ s/\r\n?Content\-type\: [^\r\n]+\; name\=\"[^\r\n]+\"\r\n?Content\-transfer\-encoding\: base64\r\n?[\r\n]*[A-Z0-9\+\/\=\r\n]+/\r\n/i;
	    next if !$overwrite && -e $ofile;
	    print "Base64 found.\n";
	    $encoded_data =~ s/[\r\n]//g;
	    if (open(F, ">$ofile")){
		binmode(F);
		print(F decode_base64($encoded_data));
		close(F);
		$filesize = -s $ofile;
		$totalsize += $filesize;
		writelog(" $b64fn \(".sprintf( "% 11s", prety_size( $filesize ) )."\) from $marea");
		$i = 0;
		$files++;
		undef $encoded_data;
	    } else {
		print STDERR "Can't open \"$ofile\"\: $!\.\n";
		writelog("Can't open \"$ofile\"\: $!\.");
	    }
	}
	writelog( "-------------------------------------------------------------------------\n".
		" Total decoded $files files, \(".sprintf( "% 12s", prety_size( $totalsize ) )."\) from $marea\n");
	print "Total decoded $files files, \(".sprintf( "% 12s", prety_size( $totalsize ) )."\) from $marea\n" if $files > 0;

return $i;
}

my $whatsnew = '\nver.0.8\n - The amount of memory used has been significantly reduced.\n\n';

sub update()
{
	
	my ( $ver_s, $upd, $of );

	$0 =~ /(.*[\\\/])[^\\\/]+$/;
	my $curpath = $1;
	$curpath = '' unless defined $curpath;

	$ver_s = get('http://brorabbit.g0x.ru/files/perl/uudecode.v');
	if (defined ($ver_s) ) {
		if ( $vers lt $ver_s ) {

			if ( $check_updates ) {
				$of = "${curpath}uudecode.pl";
				print "uudecode.pl will be updated to $ver_s\!\n$whatsnew";
				writelog(" \*\*\* Updating uudecode.pl to $ver_s\!\n$whatsnew");
			} else {
				$of = "${curpath}uudecode_${ver_s}.pl";
				print "You should update to $ver_s\!\n$whatsnew";
				writelog(" \*\*\* You should update to $ver_s\! Update filename is \'uudecode_${ver_s}.pl\'.\n$whatsnew");
			}

			$upd = get( 'http://brorabbit.g0x.ru/files/perl/uudecode.pl' );
			print STDERR "Can't get update.\n" &&
				return unless defined $upd;
			if ( open ( OF, ">$of") ) {
				binmode(OF);
				print( OF $upd );
				close(OF);
				chmod 0755, $of if $^O eq 'linux';
				print "$of saved.\n\n";
			} else {
				print STDERR "Can't open $of ($!).\n";
			}
		} else {
			print "You have actual version.\n";
		}
	}
}

GetOptions (
#            "help"        => \$usage,    # flag
            "overwrite"   => \$overwrite, # flag
            "decode-to=s" => \$decodeto,  # string
            "area-name=s" => \$areaname,  # string
            "log=s"       => \$logfile,   # string
	    "no-update"   => \$no_check_updates, #flag
	    "update"      => \$check_updates #flag
           ) or die("Error in command line arguments\n");

$uuefile = shift @ARGV;


writelog("uudecode.pl $vers by Stas Mishchenkov 2:460/58.\n");
print "uudecode.pl $vers by Stas Mishchenkov 2:460/58.\n";
usage() unless defined( $uuefile );

if ( $no_check_updates && $check_updates) {
	print STDERR "\n It makes no sense to use the --update [| -u] and --no-update [| -n] options at the same time.\n";
	exit;
}

update() unless $no_check_updates;

if ( !defined($decodeto) ){
File::Spec->rel2abs( __FILE__ ) =~ /(.*[\\\/])[^\\\/]+$/;
	$decodeto =  $1;
	$decodeto =  '.' unless defined($decodeto);
}
$areaname = 'Decoded.Files' unless defined($areaname);

$size = -s $uuefile;
print "Decoding $uuefile, ". prety_size( $size )."\n";

        writelog( sprintf( " %02d\-%02d\-%04d %02d\:%02d\:%02d\n~~~~~~~~~~~~~~~~~~~~~",
			 (localtime)[3], 1+(localtime)[4], 1900+(localtime)[5],
			  (localtime)[2], (localtime)[1], (localtime)[0] ));

my $rc;

if ( open(F, "<$uuefile") ) {
    binmode(F);
    read(F, $mtext, $size);
    close(F);
    $rc = uu_decode( $areaname, $decodeto, $overwrite );
    print "No new files decoded.\n" if $rc == 1;
} else {
	print STDERR "Can't open \'$uuefile\'.($!)\n";
	writelog("Can't open \'$uuefile\'.($!)");
}