yencode.tcl

Linux下的MSN聊天程序源码

# yencode.tcl - Copyright (C) 2002 Pat Thoyts <[e-mail]>
#
# Provide a Tcl only implementation of yEnc encoding algorithm
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# @(#)$Id: yencode.tcl 3433 2004-12-03 15:51:40Z germinator2000 $

package require Tcl 8.2;                # tcl minimum version
package require crc32;                  # tcllib 1.1

namespace eval ::yencode {
    variable version 1.0.1
    namespace export encode decode yencode ydecode
}

# -------------------------------------------------------------------------

proc ::yencode::encode {s} {
    set r {}
    binary scan $s c* d
    foreach {c} $d {
        set v [expr {($c + 42) % 256}]
        if {$v == 0x00 || $v == 0x09 || $v == 0x0A 
            || $v == 0x0D || $v == 0x3D} {
            append r "="
            set v [expr {($v + 42) % 256}]
        }
        append r [format %c $v]
    }
    return $r
}

proc ::yencode::decode {s} {
    if {[string length $s] == 0} {return ""}
    set r {}
    set esc 0
    binary scan $s c* d
    foreach c $d {
        if {$c == 61 && $esc == 0} {
            set esc 1
            continue
        }
        set v [expr {($c - 42) % 256}]
        if {$esc} {
            set v [expr {($v - 42) % 256}]
            set esc 0
        }
        append r [format %c $v]
    }
    return $r
}

# -------------------------------------------------------------------------
# Description:
#  Pop the nth element off a list. Used in options processing.
#
proc ::yencode::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

# -------------------------------------------------------------------------

proc ::yencode::yencode {args} {
    array set opts {mode 0644 filename {} name {} line 128 crc32 1}
    while {[string match -* [lindex $args 0]]} {
        switch -glob -- [lindex $args 0] {
            -f* { set opts(filename) [Pop args 1] }
            -m* { set opts(mode) [Pop args 1] }
            -n* { set opts(name) [Pop args 1] }
            -l* { set opts(line) [Pop args 1] }
            -c* { set opts(crc32) [Pop args 1] }
            --  { Pop args ; break }
            default {
                set options [join [lsort [array names opts]] ", -"]
                return -code error "bad option [lindex $args 0]:\
                      must be -$options"
            }
        }
        Pop args
    }

    if {$opts(name) == {}} {
        set opts(name) $opts(filename)
    }
    if {$opts(name) == {}} {
        set opts(name) "data.dat"
    }
    if {! [string is boolean $opts(crc32)]} {
        return -code error "bad option -crc32: argument must be true or false"
    }

    if {$opts(filename) != {}} {
        set f [open $opts(filename) r]
        fconfigure $f -translation binary
        set data [read $f]
        close $f
    } else {
        if {[llength $args] != 1} {
            return -code error "wrong \# args: should be\
                  \"yencode ?options? -file name | data\""
        }
        set data [lindex $args 0]
    }
    
    set opts(size) [string length $data]
    
    set r {}
    append r [format "=ybegin line=%d size=%d name=%s" \
                  $opts(line) $opts(size) $opts(name)] "\n"

    set ndx 0
    while {$ndx < $opts(size)} {
        set pln [string range $data $ndx [expr {$ndx + $opts(line) - 1}]]
        set enc [encode $pln]
        incr ndx [string length $pln]
        append r $enc "\r\n"
    }

    append r [format "=yend size=%d" $ndx]
    if {$opts(crc32)} {
        append r " crc32=" [crc::crc32 -format %x $data]
    }
    return $r
}

# -------------------------------------------------------------------------
# Description:
#  Perform ydecoding of a file or data. A file may contain more than one
#  encoded data section so the result is a list where each element is a 
#  three element list of the provided filename, the file size and the 
#  data itself.
#
proc ::yencode::ydecode {args} {
    array set opts {mode 0644 filename {} name default.bin}
    while {[string match -* [lindex $args 0]]} {
        switch -glob -- [lindex $args 0] {
            -f* { set opts(filename) [Pop args 1] }
            -- { Pop args ; break; }
            default {
                set options [join [lsort [array names opts]] ", -"]
                return -code error "bad option [lindex $args 0]:\
                      must be -$opts"
            }
        }
        Pop args
    }

    if {$opts(filename) != {}} {
        set f [open $opts(filename) r]
        set data [read $f]
        close $f
    } else {
        if {[llength $args] != 1} {
            return -code error "wrong \# args: should be\
                  \"ydecode ?options? -file name | data\""
        }
        set data [lindex $args 0]
    }

    set state false
    set result {}

    foreach {line} [split $data "\n"] {
        set line [string trimright $line "\r\n"]
        switch -exact -- $state {
            false {
                if {[string match "=ybegin*" $line]} {
                    regexp {line=(\d+)} $line -> opts(line)
                    regexp {size=(\d+)} $line -> opts(size)
                    regexp {name=(\d+)} $line -> opts(name)

                    if {$opts(name) == {}} {
                        set opts(name) default.bin
                    }

                    set state true
                    set r {}
                }
            }

            true {
                if {[string match "=yend*" $line]} {
                    set state false
                    lappend result [list $opts(name) $opts(size) $r]
                } else {
                    append r [decode $line]
                }
            }
        }
    }

    return $result
}

# -------------------------------------------------------------------------

package provide yencode $::yencode::version

# -------------------------------------------------------------------------
#
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End: