1
# uuencode - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
3
# Provide a Tcl only implementation of uuencode and uudecode.
5
# -------------------------------------------------------------------------
6
# See the file "license.terms" for information on usage and redistribution
7
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
8
# -------------------------------------------------------------------------
9
# @(#)$Id: uuencode.tcl,v 1.1 2004/12/03 15:51:40 germinator2000 Exp $
11
package require Tcl 8.2; # tcl minimum version
12
package require log; # tcllib 1.0
14
namespace eval ::uuencode {
15
variable version 1.0.2
17
namespace export encode decode uuencode uudecode
20
proc ::uuencode::Enc {c} {
21
return [format %c [expr {($c != 0) ? (($c & 0x3f) + 0x20) : 0x60}]]
24
proc ::uuencode::Encode {s} {
27
foreach {c1 c2 c3} $d {
28
if {$c1 == {}} {set c1 0}
29
if {$c2 == {}} {set c2 0}
30
if {$c3 == {}} {set c3 0}
31
append r [Enc [expr {$c1 >> 2}]]
32
append r [Enc [expr {(($c1 << 4) & 060) | (($c2 >> 4) & 017)}]]
33
append r [Enc [expr {(($c2 << 2) & 074) | (($c3 >> 6) & 003)}]]
34
append r [Enc [expr {($c3 & 077)}]]
39
proc ::uuencode::Decode {s} {
40
if {[string length $s] == 0} {return ""}
42
binary scan [pad $s] c* d
44
foreach {c0 c1 c2 c3} $d {
45
append r [format %c [expr {((($c0-0x20)&0x3F) << 2) & 0xFF
46
| ((($c1-0x20)&0x3F) >> 4) & 0xFF}]]
47
append r [format %c [expr {((($c1-0x20)&0x3F) << 4) & 0xFF
48
| ((($c2-0x20)&0x3F) >> 2) & 0xFF}]]
49
append r [format %c [expr {((($c2-0x20)&0x3F) << 6) & 0xFF
50
| (($c3-0x20)&0x3F) & 0xFF}]]
55
# -------------------------------------------------------------------------
58
# Permit more tolerant decoding of invalid input strings by padding to
59
# a multiple of 4 bytes with nulls.
61
# Returns the input string - possibly padded with uuencoded null chars.
63
proc ::uuencode::pad {s} {
64
if {[set mod [expr {[string length $s] % 4}]] != 0} {
65
log::log notice "invalid uuencoded string: padding string to a\
67
append s [string repeat "`" [expr {4 - $mod}]]
72
# -------------------------------------------------------------------------
74
# If the Trf package is available then we shall use this by default but the
75
# Tcllib implementations are always visible if needed (ie: for testing)
76
if {[catch {package require Trf 2.0}]} {
77
interp alias {} ::uuencode::encode {} ::uuencode::Encode
78
interp alias {} ::uuencode::decode {} ::uuencode::Decode
80
proc ::uuencode::encode {s} {
81
return [::uuencode -mode encode -- $s]
83
proc ::uuencode::decode {s} {
84
return [::uuencode -mode decode -- [pad $s]]
88
# -------------------------------------------------------------------------
90
proc ::uuencode::uuencode {args} {
91
array set opts {mode 0644 filename {} name {}}
92
while {[string match -* [lindex $args 0]]} {
93
switch -glob -- [lindex $args 0] {
95
set opts(filename) [lindex $args 1]
96
set args [lreplace $args 0 0]
99
set opts(mode) [lindex $args 1]
100
set args [lreplace $args 0 0]
103
set opts(name) [lindex $args 1]
104
set args [lreplace $args 0 0]
107
set args [lreplace $args 0 0]
111
return -code error "bad option [lindex $args 0]:\
112
must be -filename or -mode"
115
set args [lreplace $args 0 0]
118
if {$opts(name) == {}} {
119
set opts(name) $opts(filename)
121
if {$opts(name) == {}} {
122
set opts(name) "data.dat"
125
if {$opts(filename) != {}} {
126
set f [open $opts(filename) r]
127
fconfigure $f -translation binary
131
if {[llength $args] != 1} {
132
return -code error "wrong \# args: should be\
133
\"uuencode ?-mode oct? -file name | data\""
135
set data [lindex $args 0]
139
append r [format "begin %o %s" $opts(mode) $opts(name)] "\n"
140
for {set n 0} {$n < [string length $data]} {incr n 45} {
141
set s [string range $data $n [expr {$n + 44}]]
142
append r [Enc [string length $s]]
143
append r [encode $s] "\n"
149
# -------------------------------------------------------------------------
151
# Perform uudecoding of a file or data. A file may contain more than one
152
# encoded data section so the result is a list where each element is a
153
# three element list of the provided filename, the suggested mode and the
156
proc ::uuencode::uudecode {args} {
157
array set opts {mode 0644 filename {}}
158
while {[string match -* [lindex $args 0]]} {
159
switch -glob -- [lindex $args 0] {
161
set opts(filename) [lindex $args 1]
162
set args [lreplace $args 0 0]
165
set args [lreplace $args 0 0]
169
return -code error "bad option [lindex $args 0]:\
170
must be -filename or -mode"
173
set args [lreplace $args 0 0]
176
if {$opts(filename) != {}} {
177
set f [open $opts(filename) r]
181
if {[llength $args] != 1} {
182
return -code error "wrong \# args: should be\
183
\"uudecode -file name | data\""
185
set data [lindex $args 0]
191
foreach {line} [split $data "\n"] {
192
switch -exact -- $state {
194
if {[regexp {^begin ([0-7]+) ([^\s]*)} $line \
195
-> opts(mode) opts(name)]} {
202
if {[string match "end" $line]} {
204
lappend result [list $opts(name) $opts(mode) $r]
207
set n [expr {($c - 0x21)}]
208
append r [string range \
209
[decode [string range $line 1 end]] 0 $n]
218
# -------------------------------------------------------------------------
220
package provide uuencode $::uuencode::version
222
# -------------------------------------------------------------------------
226
# indent-tabs-mode: nil
added
removed
utils/base64/uuencode.tcl
