1#!/usr/bin/perl 2# 3# UUE library for HPT perl (c) Stas Mishchenkov 2:460/58 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; either version 2 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# Usage: 16# Put uue.pm somewere in @INC path. It's strongly recomended 17# for Windows users to put it in the same directory with filter.pl. 18# 19# Insert into config: 20# hptperlfile /home/fido/lib/filter.pl 21# and place to filter.pl some like this: 22# 23# use uue; 24# 25# sub put_msg { 26# return uu_decode( $area, $text ); 27# } 28# if uue is detected and decoded, the message will not be placed in the area. 29# 30# or 31# sub put_msg() 32# { 33# if ( uu_decode( $area, $text ) == 0 ) { 34# $text =~ s/\rbegin 644[ ]+([^ \r]+)\r[^ ]*\rend\r/\rbegin 644 $1\r\[ uue skipped \]\rend\r/g; 35# $change=1; 36# } 37# return 1; 38# } 39# if uue is detected and decoded, uue code will be deleted from the message and 40# the message will be placed in the area. 41# 42# or 43# sub filter() 44# { 45# uu_decode( $area, $text,undef,1 ) if defined( $area ); 46# } 47# uue will be decoded from all echo areas. Decoded files will overwrite 48# existing files and will be placed in UUE subdirectory of ProtInbound from HPT 49# config file. 50# 51# or 52# sub filter() 53# { 54# uu_decode( 'NetMail', $text, '/home/fido/files' ) if !defined( $area ); 55# } 56# uue will be decoded from netmail area. Decoded files will overwrite 57# existing files and will be placed in '/home/fido/files/NETMAIL' directory. 58# 59# uu_decode( $area, $text, $decodedir, $overwrite ); 60# $area - Areatag. MUST be the echo area tag or 'NetMail' 61# $text - MUST be message text 62# $decodedir - Should be the full path to the directory, where you 63# wish to decode files. If not present, the default 64# name is UUE in ProtInbound from HPT config file. 65# $overwrite - Should be 1, if you wish to overwrite existing files 66# by decoded files, 0 or undefined, if not. 67# Default is to not overwrite existing files by 68# renaming decoded files. 69# returns 0 if uue detected and 1 otherwise. 70# 71# uu_encode($filename, $mode); 72# $filename - Fully qualified filename (with path) of file you wish 73# to uu encode. 74# $mode - May be omitted. Default is 0644. 75# 76# 77# Also it can be used in any perl script without HPT like this: 78#---- decode.pl ---- 79# !/usr/bin/perl 80# use uue; 81# 82# my ($uuefile, $text, $size); 83# 84# if ( defined( @ARGV[0] ) ) { 85# $uuefile = @ARGV[0]; 86# } else { die "Usage: dec.pl path/filename.ext\n\n"; } 87# 88# my $size = -s $uuefile; 89# print "Decoding $uuefile, $size bytes\n"; 90# 91# if ( open(F, "<$uuefile") ) { 92# binmode(F); 93# read(F, $text, $size); 94# close(F); 95# uu_decode("decoded", $text, '/home/fido/files', 1); 96# } 97#---- decode.pl ---- 98# 99# or like this: 100#---- encode.pl ---- 101# !/usr/bin/perl 102# use uue; 103# 104# my ($binfile, $uuefile); 105# 106# if ( defined( @ARGV[0] ) ) { 107# $binfile = @ARGV[0]; 108# $uuefile = @ARGV[0] .".uue"; 109# } else { die "Usage: dec.pl path/filename.ext\n\n"; } 110# 111# if ( open(F, ">$uuefile") ) { 112# binmode(F); 113# print( F uu_encode( $binfile ) ); 114# close(F); 115# } 116#---- encode.pl ---- 117# 118 119 120sub uu_decode($$;$$) 121{ 122 local ($marea, $mtext, $uuedir, $overwrite) = @_; 123 local ($slash, $uudecoded_data, @uuelines, $decdir, $ofile); 124 125 if ( $config{protInbound} =~ /([\\\/])/ ){ 126 $slash = $1; 127 } else { 128 $ENV{TMP} =~ /([\\\/])/; 129 $slash = $1; 130 } 131 if ( !defined($uuedir) ){ 132 $uuedir = $config{protInbound}."uue"; 133 } else { 134 if ($uuedir =~ /(.*)[\\\/]$/){ 135 $uuedir = $1; 136 } 137 } 138 local ($i, $d) = (0, $uuedir); 139 while ( -e $uuedir && !-d $uuedir) { 140 $uuedir = sprintf( "$d\.%04x", $i); 141 $i++; 142 if ($i >= 65535) { # maximum files for FA32 file system. 143 w_log("So may files \"$uuedir\".") if defined($config{protInbound}); 144 print STDERR "So may files \"$uuedir\".\n"; 145 return 1; 146 } 147 } 148 mkdir $uuedir if !-e $uuedir; 149 $i = 1; 150 while ( $mtext =~ /\r\n?begin 644[ ]+([^ \r\n?]+)\r\n?([^ ]*?\r\n?)end\r\n?/i ){ 151 @uuelines = split(/\r\n?/,$2); 152 $decdir = $uuedir . $slash . uc($marea); 153 $ofile = $decdir . $slash . $1; 154 $ofile = find_free_filename($ofile) if !$overwrite; 155 mkdir $decdir if !-e $decdir; 156 if (open(F, ">$ofile")){ 157 binmode(F); 158 foreach my $val ( @uuelines ){ 159 $uudecoded_data = unpack("u", $val); 160 print(F $uudecoded_data); 161 } 162 close(F); 163 undef @uuelines; 164 $i = 0; 165 } else { 166 w_log("Can't open \"$ofile\"\: $!\.") if defined($config{protInbound}); 167 print STDERR "Can't open \"$ofile\"\: $!\.\n"; 168 } 169 $mtext =~ s/\r\n?begin 644[ ]+[^ \r\n?]+\r\n?[^ ]*?\r\n?end\r\n?/\r\n/i; 170 } 171return $i; 172} 173 174 175sub uu_encode($;$) 176{ 177 178 local ($filename, $mode) = @_; 179 local ($uuestr, $bindata); 180 181 $mode ||= "644"; 182 if ( $filename =~ /([^\\\/]+)$/ ) { 183 $uuestr = "\rbegin $mode $1\r"; 184 } else { 185 w_log("Full path MUST be specified. $filename has no path.") if defined($config{protInbound}); 186 print STDERR "Full path MUST be specified. $filename has no path.\n"; 187 return ''; 188 } 189 if ( open( FUU, $filename ) ) { 190 binmode( FUU, ':raw' ); 191 while ( read( FUU, $bindata, 45 ) ) { 192 $uuestr .= pack("u", $bindata); 193 } 194 close(FUU); 195 $uuestr .= "end\r\r"; 196 return($uuestr); 197 } 198 else { 199 w_log("Can't open \"$filename\"\: $!") if defined($config{protInbound}); 200 print STDERR "Can't open \"$filename\"\: $!\n"; 201 return(''); 202 } 203} 204 205sub find_free_filename($) 206{ 207 local ($o_file) = @_; 208 local ($o_fname, $o_ext); 209 if ( $o_file =~ /^(.*)(\.[^\.\\\/]+)$/ ) { 210 ($o_fname, $o_ext) = ($1, $2); 211 } else { 212 ($o_fname, $o_ext) = ($o_file, ''); 213 } 214 local $o_i = 0; 215 while (-e $o_file) { 216 $o_file = sprintf("$o_fname%04x$o_ext", $o_i); 217 $o_i++; 218 if ($o_i > 65535) { 219 $o_file = $o_fname . $o_ext; 220 } 221 } 222return $o_file; 223} 224 2251; 226