# small 9p implementation in tcl by Axel.Belinfante@cs.utwente.nl
# it needs tclDES from http://tcldes.sourceforge.net/
# I have used version 0.8 with good success
# this is based on the python 9P implementation by Tim Newsham.
# http://lava.net/~newsham/plan9/
package require tclDES
namespace eval p9sk1 {
variable TickReqLen 141
variable TickLen 72
variable AuthLen 13
variable AuthTreq 1
variable AuthChal 2
variable AuthPass 3
variable AuthOK 4
variable AuthErr 5
variable AuthMod 6
variable AuthTs 64
variable AuthTc 65
variable AuthAs 66
variable AuthAc 67
variable AuthTp 68
variable AuthHr 69
variable AUTHPORT 567
variable _par [list \
0x01 0x02 0x04 0x07 0x08 0x0b 0x0d 0x0e \
0x10 0x13 0x15 0x16 0x19 0x1a 0x1c 0x1f \
0x20 0x23 0x25 0x26 0x29 0x2a 0x2c 0x2f \
0x31 0x32 0x34 0x37 0x38 0x3b 0x3d 0x3e \
0x40 0x43 0x45 0x46 0x49 0x4a 0x4c 0x4f \
0x51 0x52 0x54 0x57 0x58 0x5b 0x5d 0x5e \
0x61 0x62 0x64 0x67 0x68 0x6b 0x6d 0x6e \
0x70 0x73 0x75 0x76 0x79 0x7a 0x7c 0x7f \
0x80 0x83 0x85 0x86 0x89 0x8a 0x8c 0x8f \
0x91 0x92 0x94 0x97 0x98 0x9b 0x9d 0x9e \
0xa1 0xa2 0xa4 0xa7 0xa8 0xab 0xad 0xae \
0xb0 0xb3 0xb5 0xb6 0xb9 0xba 0xbc 0xbf \
0xc1 0xc2 0xc4 0xc7 0xc8 0xcb 0xcd 0xce \
0xd0 0xd3 0xd5 0xd6 0xd9 0xda 0xdc 0xdf \
0xe0 0xe3 0xe5 0xe6 0xe9 0xea 0xec 0xef \
0xf1 0xf2 0xf4 0xf7 0xf8 0xfb 0xfd 0xfe \
]
}
proc p9sk1::pad {str l {padch {}}} {
set n [expr $l - [string length $str]]
set s $str
if {$padch == {}} {
set padch [binary format x]
}
append s [string repeat $padch $n]
return $s
}
# Expand a 7-byte DES key into an 8-byte DES key
proc p9sk1::expandKey {key} {
variable _par
binary scan $key c* tbuf
set k {}
foreach x $tbuf {
lappend k [expr $x & 0xff]
}
lappend k64 [expr [lindex $k 0] >> 1]
lappend k64 [expr ([lindex $k 1] >> 2) | ([lindex $k 0] << 6)]
lappend k64 [expr ([lindex $k 2] >> 3) | ([lindex $k 1] << 5)]
lappend k64 [expr ([lindex $k 3] >> 4) | ([lindex $k 2] << 4)]
lappend k64 [expr ([lindex $k 4] >> 5) | ([lindex $k 3] << 3)]
lappend k64 [expr ([lindex $k 5] >> 6) | ([lindex $k 4] << 2)]
lappend k64 [expr ([lindex $k 6] >> 7) | ([lindex $k 5] << 1)]
lappend k64 [expr [lindex $k 6] << 0]
foreach x $k64 {
lappend r [lindex $_par [expr $x & 0x7f]]
}
return [binary format c* $r]
}
proc p9sk1::newKey {key} {
set e [expandKey $key]
return [::des::keyset create $e]
}
proc p9sk1::encrypt {key msg} {
set r [::des::encrypt $key $msg]
return $r
}
proc p9sk1::decrypt {key msg} {
set r [::des::decrypt $key $msg]
return $r
}
proc p9sk1::makeKey {password} {
set password [string range $password 0 26]
append password [binary format x]
set n [expr [string length $password] - 1]
set password [p9sk1::pad $password 28 { }]
set buf $password
while {1} {
set ts [string range $buf 0 7]
binary scan $ts c* tl
set t {}
foreach x $tl {
lappend t [expr $x & 0xff]
}
set i 0
set k {}
while {$i < 7} {
lappend k [expr ([lindex $t $i] >> $i) + ([lindex $t [expr $i + 1]] << (8-($i + 1))) & 0xff]
incr i
}
set key [binary format c* $k]
if {$n <= 8} {
return $key
}
incr n -8
if {$n < 8} {
set buf [string range $buf $n end]
} else {
set buf [string range $buf 8 end]
}
set buf [string replace $buf 0 7 [::p9sk1::encrypt [newKey $key] [string range $buf 0 7]]]
}
}
# XXX This is *NOT* a secure way to generate random strings!
# This should be fixed if this code is ever used in a serious manner.
proc p9sk1::randChars {n} {
set i 0
while {$i < $n} {
lappend r [expr int(rand()*255)]
incr i
}
return [binary format c* $r]
}
namespace eval 9p::marshal {
# upvar #0 C_[set self](ks) ks
# upvar #0 C_[set self](kn) kn
# set ks None
# set kn None
}
proc 9p::marshal::setKs {self k} {
upvar #0 C_[set self](ks) ks
set ks [::p9sk1::newKey $k]
}
proc 9p::marshal::setKn {self k} {
upvar #0 C_[set self](kn) kn
set kn [::p9sk1::newKey $k]
}
proc 9p::marshal::encrypt {self n key} {
set idx [expr [lenBuf $self] - $n]
incr n -1
set dummy 0
while {$dummy < [expr $n / 7]} {
set end [expr $idx + 8 -1]
replaceBuf $self $idx $end [::p9sk1::encrypt $key [rangeBuf $self $idx $end]]
incr idx 7
incr dummy
}
if {$n % 7} {
set end [expr [lenBuf $self] - 1]
set start [expr $end - 8 + 1]
replaceBuf $self $start $end [::p9sk1::encrypt $key [rangeBuf $self $start $end]]
}
}
proc 9p::marshal::decrypt {self n key} {
upvar #0 C_[set self](kn) kn
if {[string compare $key None] == 0} {
return
}
set m [expr $n -1 ]
if {$m % 7} {
set start [expr $n - 8]
set end [expr $n - 1]
replaceBuf $self $start $end [::p9sk1::decrypt $key [rangeBuf $self $start $end]]
}
set idx [expr $m - ($m % 7)]
set dummy 0
while {$dummy < [expr $m / 7]} {
incr idx -7
set end [expr $idx + 8 - 1]
replaceBuf $self $idx $end [::p9sk1::decrypt $key [rangeBuf $self $idx $end]]
incr dummy
}
}
proc 9p::marshal::encPad {self x l} {
encX $self [::p9sk1::pad $x $l]
}
proc 9p::marshal::decPad {self l} {
set x [decX $self $l]
set z [binary format x]
set idx [string first $z $x]
if {$idx >= 0} {
set x [string range $x 0 [expr $idx - 1]]
}
return $x
}
proc 9p::marshal::encChal {self x} {
checkLen $x 8
encX $self $x
}
proc 9p::marshal::decChal {self} {
set r [decX $self 8]
return $r
}
proc 9p::marshal::encTicketReq {self x} {
enc1 $self [lindex $x 0] ;# type
encPad $self [lindex $x 1] 28 ;# authid
encPad $self [lindex $x 2] 48 ;# authdom
encChal $self [lindex $x 3] ;# chal
encPad $self [lindex $x 4] 28 ;# hostid
encPad $self [lindex $x 5] 28 ;# uid
}
proc 9p::marshal::decTicketReq {self} {
set r [list \
[dec1 $self] \
[decPad $self 28] \
[decPad $self 48] \
[decChal $self] \
[decPad $self 28] \
[decPad $self 28] \
]
return $r
}
proc 9p::marshal::encTicket {self x} {
upvar #0 C_[set self](ks) ks
set num [lindex $x 0]
set chal [lindex $x 1]
set cuid [lindex $x 2]
set suid [lindex $x 3]
set key [lindex $x 4]
checkLen $key 7
enc1 $self $num
encChal $self $chal
encPad $self $cuid 28
encPad $self $suid 28
encX $sel $key
encrypt $self [expr 1 + 8 + 28 + 28 + 7] $ks
}
proc 9p::marshal::decTicket {self} {
upvar #0 C_[set self](ks) ks
decrypt $self [expr 1 + 8 + 28 + 28 + 7] $ks
set r [list \
[dec1 $self] \
[decChal $self] \
[decPad $self 28] \
[decPad $self 28] \
[decX $self 7] \
]
return $r
}
proc 9p::marshal::encAuth {self x} {
upvar #0 C_[set self](kn) kn
set num [lindex $x 0]
set chal [lindex $x 1]
set id [lindex $x 2]
enc1 $self $num
encChal $self $chal
enc4 $self $id
encrypt $self [expr 1 + 8 + 4] $kn
}
proc 9p::marshal::decAuth {self} {
upvar #0 C_[set self](kn) kn
decrypt $self [expr 1 + 8 + 4] $kn
set r [list \
[dec1 $self] \
[decChal $self] \
[dec4 $self] \
]
return $r
}
proc 9p::marshal::encTattach {self x} {
set tick [lindex $x 0]
set auth [lindex $x 1]
checkLen $tick 72
encX $self $tick
encAuth $self $auth
}
proc 9p::marshal::decTattach {self} {
set r [list \
[decX $self 72] \
[decAuth $self] \
]
return $r
}
# Connect to the auth server and request a set of tickets.
# Con is an open handle to the auth server, sk1 is a handle
# to a P9sk1 marshaller with Kc set and treq is a ticket request.
# Return the (opaque) server ticket and the (decoded) client ticket.
proc p9sk1::getTicket {con sk1 treq} {
variable AuthOK
variable AuthErr
::9p::marshal::setBuf $sk1 ""
::9p::marshal::encTicketReq $sk1 $treq
set x [::9p::marshal::getBuf $sk1]
::9p::marshal::swrite $con $x
set ch [::9p::marshal::sread $con 1]
if {$ch == [binary format c $AuthErr]} {
set err [::9p::marshal::sread $con 64]
error "AuthsrvError $err"
} elseif {$ch != [binary format c $AuthOK]} {
error "AuthsrvError invalid reply type [::9p::_dump $ch]"
}
set ctick [::9p::marshal::sread $con 72]
set stick [::9p::marshal::sread $con 72]
if {[expr [string length $ctick] + [string length $stick]] != [expr 2*72]} {
error "AuthsrvError short auth reply"
}
::9p::marshal::setBuf $sk1 $ctick
set ctl [::9p::marshal::decTicket $sk1]
set r [list $ctl $stick]
return $r
}
# Authenticate ourselves to the server.
# Cl is a P9 RpcClient, afid is the fid to use, user is the
# user name, Kc is the user's key, authsrv and authport specify
# the auth server to use for requesting tickets.
#
# XXX perhaps better if the auth server can be prompted for
# based on the domain in the negotiation.
proc p9sk1::clientAuth {cl afid user Kc authsrv {authport 567}} {
variable TickReqLen
variable AuthLen
variable AuthTreq
variable AuthTc
variable AuthAc
variable AuthAs
set CHc [randChars 8]
set sk1 aapje
::9p::marshal::setKs $sk1 $Kc
::9p::afidopen $cl $afid
set gen 0
# negotiate
set proto [::9p::read $cl $afid 128]
set v2 0
if {[string compare [string range $proto 0 9] {v.2 p9sk1@}] == 0} {
set v2 1
set proto [string range $proto 4 end]
}
if {[string compare [string range $proto 0 5] {p9sk1@}] != 0} {
error "AuthError unknown protocol $proto"
}
set idx [string first @ $proto]
::9p::write $cl $afid [string replace $proto $idx $idx { }]
if {$v2} {
set ok [::9p::read $cl $afid 3]
if {[string compare $ok OK[binary format x]] != 0} {
error "AuthError v.2 protocol botch"
}
}
# Tsession
::9p::marshal::setBuf $sk1 ""
::9p::marshal::encChal $sk1 $CHc
::9p::write $cl $afid [::9p::marshal::getBuf $sk1]
# Rsession
::9p::marshal::setBuf $sk1 [::9p::read $cl $afid $TickReqLen]
set treq [::9p::marshal::decTicketReq $sk1]
if {$v2 && [lindex $treq 0] == 0} {
# kenfs is fast and loose with auth formats
set treq [lreplace $treq 0 0 $AuthTreq]
}
if {[lindex $treq 0] != $AuthTreq} {
error "AuthError bad server"
}
set CHs [lindex $treq 3]
# request ticket from authsrv
set treq [lreplace $treq end-1 end $user $user]
puts stderr "connecting to tcp!$authsrv!$authport"
set asock [socket $authsrv $authport]
fconfigure $asock -translation binary
set ticket [getTicket $asock $sk1 $treq] ;# XXX catch
set ctick [lindex $ticket 0]
set stick [lindex $ticket 1]
set num [lindex $ctick 0]
set CHs2 [lindex $ctick 1]
set cuid [lindex $ctick 2]
set suid [lindex $ctick 3]
set Kn [lindex $ctick 4]
close $asock
if {$num != $AuthTc || $CHs != $CHs2} {
error "AuthError bad password for $user or bad auth server"
} elseif {$num != $AuthTc} {
error "AuthError bad password for $user"
} elseif {$CHs != $CHs2} {
error "bad auth server"
}
::9p::marshal::setKn $sk1 $Kn
# Tattach
::9p::marshal::setBuf $sk1 ""
::9p::marshal::encTattach $sk1 [list $stick [list $AuthAc $CHs $gen]]
set b [::9p::marshal::getBuf $sk1]
::9p::write $cl $afid $b
set a [::9p::read $cl $afid $AuthLen]
::9p::marshal::setBuf $sk1 $a
set r [::9p::marshal::decAuth $sk1]
set num [lindex $r 0]
set CHc2 [lindex $r 1]
set gen2 [lindex $r 2]
if {$num != $AuthAs || $CHc2 != $CHc} {
# XXX check gen2 for replay
error "AuthError bad server"
}
return
}
|
