#!/bin/sh
# \
	exec tclsh "$0" ${1+"$@"}
#
# Copyright C 2002-2003 Sun Microsystems, Inc.
# All rights reserved. Use is subject to license terms.
#
# 
# Sun, Sun Microsystems, and the Sun logo are trademarks or registered
# trademarks of Sun Microsystems, Inc. in the United States and other
# countries.
# 
# Federal Acquisitions: Commercial Software--Government Users Subject to
# Standard License Terms and Conditions
#

array set status { bad bad eof eof exitMsg exitMsg ready ready timeout timeout }

for {set i 1} {$i <= 256} {incr i} {
    set c [format %c $i]
    if {![string match \[a-zA-Z0-9\] $c]} {
        set map($c) %[format %.2x $i]
    }
}

array set map { \n %0d%0a , , . . "(" "(" ")" ")" "-" "-"}

array set tbl { \
        0 A 1 B 2 C 3 D 4 E 5 F 6 G 7 H \
        8 I 9 J 10 K 11 L 12 M 13 N 14 O 15 P \
        16 Q 17 R 18 S 19 T 20 U 21 V 22 W 23 X \
        24 Y 25 Z 26 a 27 b 28 c 29 d 30 e 31 f \
        32 g 33 h 34 i 35 j 36 k 37 l 38 m 39 n \
        40 o 41 p 42 q 43 r 44 s 45 t 46 u 47 v \
        48 w 49 x 50 y 51 z 52 0 53 1 54 2 55 3 \
        56 4 57 5 58 6 59 7 60 8 61 9 62 + 63 / \
    }

proc cacls { xName iName } {
    upvar $xName x
    
    set cwd [pwd]

    cd $x(root)

    set iFile [open $iName r]

    while {[gets $iFile line] >= 0} {
	if [string length $line] {
	    if [regsub "^dps/" $line "$x(instance)/" a] {
		set line $a
	    }
	    if [file exists [string range $line 0 [expr [string first " " $line] - 1]]] {
		set cmd [linsert $line 0 exec bin/tcl8.2/dpsYes.exe | cacls]
		puts $cmd
		if [catch $cmd result] {
		    error $result
		}
		puts stdout $result
	    }
	}
    }

    close $iFile

    cd $cwd
}

proc classPathToString { files } {
    set path [lindex $files 0]

    if [Windows] {
	set sep ";"
    } else {
	set sep ":"
    }

    foreach i [lrange $files 1 end] {
	append path "$sep$i"
    }

    return $path
}

proc cmd { name } {

    if [unix] {
    } else {
	append name ".exe"
    }

    return $name
}

proc constructVars { xName script } {
    upvar $xName x

    regexp \[~0-9\]*\[0-9\]\[0-9\](\[a-z\]\[a-z\]\[a-z\]).* $script ignore x(component)

    set x(instanceRoot) [file join $x(root) $x(instance)]
}

proc dpsWriteOpen { fName permissions } {

#
# Tcl uses umask when setting actual permissions.
# We must not let an arbitrary umask value the
# user has change our desired, prescribed, value.
#

    if [unix] {
	close [open $fName w]
	exec chmod $permissions $fName
	set rc [open $fName a]
    } else {
	set rc [open $fName w]
    }

    return $rc
}



proc dpsSetup { argv } {
    global env
    global tcl_platform
    global argv0
    global launched_as_root

    set rc [expr 1]

    switch [llength $argv] {
	0
	-
	1 {
	    usage "Too few parameters."
	}
	2 {
	    set context [lindex $argv 0]
	    if [catch {source $context} result] {
		puts stderr "While attempting to source $context, the following occured:"
		puts stderr $result
	    } else {
		if [catch {init x} result] {
		    puts stderr $result
		} else {
		    #
		    set launched_as_root 0
		    set to_run_as_root   0
		    if [string equal "unix" $tcl_platform(platform)] {
			set idrc [catch {exec id 2>/dev/null} idresult]
			regexp -nocase {^uid=([0-9]+)\((.+)\)\ gid=(.+)} $idresult comp realuid username
			if [string equal "root" $username] {
			    set launched_as_root 1
			}
			if [info exists x(AdminSysUser)] {
			    if [string equal "root" $x(AdminSysUser)] {
				set to_run_as_root 1
			    } else {
				set to_run_as_root 0
			    }
			} else {
			    set to_run_as_root $launched_as_root
			}
		    }

		    if [string equal "unix" $tcl_platform(platform)] {
			set cwd [pwd]
			set rcmd "cd $cwd; $x(tclsh) $argv0 $argv"
			if { ($launched_as_root == 1) && ($to_run_as_root == 0) } {
			    cd $x(root)
			    set chownrc [catch {exec chown -R $x(AdminSysUser) $x(root)} chownresult]
			    set chgrprc [catch {exec chgrp -R $x(AdminSysGroup) $x(root)} chgrpresult]

			    # No known way to  have a setuid in Tcl, so we are exec'ing
			    # a cmd ' su - ...; rminstance.tcl'
			    # that will relaunched this given script as a different user
			    set surc [catch {exec su - [file attributes [file join $x(root)] -owner] -c "$rcmd"} suresult]
			    return $surc
			}
		    }
		    
		    # must be done just after init
		    set x(password) [unscramble $x(password)]

		    set rc [expr 0]
		    set base [lindex $argv 1]
		    set tail [file tail $base]
		    if {$x(isUninstaller)} {
			set order [list [osName] [osType] ""]
		    } else {
			set order [list "" [osType] [osName]]
		    }
		    foreach i $order {
			if {[expr $rc == 0]} {
			    set script "$base$i.tcl"
			    if [file exists $script] {
				if [catch {source $script} result] {
				    puts stderr "While attempting to source $script, the following occured:"
				    puts stderr $result
				    set rc -1
				} else {
				    constructVars x $script
				    if [unix] {
					set env(LD_LIBRARY_PATH) [file join $x(root) lib]
				    }
				    set main $tail
				    append main $i
				    append main ::main
				    puts stdout "executing $main"
				    if [catch {$main x} result] {
					puts stderr "While attempting to execute \[$main x\], the following occured:"
					puts stderr $result
					set rc -2
				    } else {
					set rc $result
				    }
				}
			    }
			}
		    }
		}
	    }
	}
	default {
	    usage "Too many parameters."
	}
    }
    
    return $rc
}

proc dropClass { x } {
    set suffix ".class"
    
    if [regexp -nocase -- $suffix $x] {
	set x [string range $x 0 [expr [string length $x] - [string length $suffix] - 1]]
    }
	
    return $x
}

proc emitASStateFile { xName id } {
    upvar $xName x
    
    set stateFileName [file join $x(root) asstatefile.txt]
    
    set oFile [open $stateFileName w]
    
    puts $oFile "#"
    puts $oFile "# Wizard Statefile created by DPS installation"
    puts $oFile "#"
    puts $oFile "\[STATE_BEGIN Sun Java(TM) System Administration Distribution $id\]"
    puts $oFile "FullMachineName = $x(fullHostname)"
    puts $oFile "defaultInstallDirectory = $x(root)"
    puts $oFile "currentInstallDirectory = $x(root)"
    
    if [unix] {
	puts $oFile "com.iplanet.install.panels.common.ComponentPanel.selectedcomponents = Sun Java(TM) System Administration Suite,Sun Java(TM) System Administration Server,Sun Java(TM) System Administration Console,Sun Java(TM) System Server Console,Sun Java(TM) System Server Console Core,Java Runtime Environment,Sun Java(TM) System Server Basic Libraries,Sun Java(TM) System Server Basic Libraries,Java Runtime Environment"
    } else {
	puts $oFile "com.iplanet.install.panels.common.ComponentPanel.selectedcomponents = Sun Java(TM) System Administration Suite,Sun Java(TM) System Administration Server,Sun Java(TM) System Administration Console,Sun Java(TM) System Server Console,Sun Java(TM) System Server Console Core,Java Runtime Environment,Sun Java(TM) System Server Basic Libraries,Sun Java(TM) System Server Basic Libraries,Java Runtime Environment,Sun Java(TM) System Server Basic System Libraries"
    }

    puts $oFile "AdminPort = $x(adminPort)"
    
    if [expr [unix] && $x(isInstaller)]  {
	puts $oFile "ServerUser = $x(ServerUser)"
	puts $oFile "ServerGroup = $x(ServerGroup)"
    }
    
    puts $oFile "ConfigDirectoryHost = $x(cdsHost)"
    puts $oFile "ConfigDirectoryPort = $x(cdsPort)"
    puts $oFile "ConfigDirectoryAdminID = $x(userID)"
    puts $oFile "ConfigDirectoryAdminPwd = $x(password)"
    puts $oFile "AdminDomain = $x(domain)"
    
    if [expr [unix] && $x(isInstaller)] {
	puts $oFile "AdminSysUser = $x(AdminSysUser)"
	puts $oFile "AdminSysGroup = $x(AdminSysGroup)"
    }
    
    puts $oFile "\[STATE_DONE Sun Java(TM) System Administration Distribution $id\]"
    
    close $oFile
    
    return $stateFileName
}

proc encode { v } {
    global tbl
    set null [format "%c" 0]
    set length [expr [string length $v]]
    switch -exact [expr $length % 3] {
        0 {
            set trim [expr [expr [expr $length + 0] / 3 * 4] - 1]
            set tag ""
        }
        1 {
            append v $null
            append v $null
            set trim [expr [expr [expr $length + 2] / 3 * 4] - 3]
            set tag "=="
        }
        2 {
            append v $null
            set trim [expr 1]
            set trim [expr [expr [expr $length + 1] / 3 * 4] - 2]
            set tag "="
        }
    }
    
    set n ""
    
    foreach { a b c } [split $v {}] {
        scan $a %c x
        scan $b %c y
        scan $c %c z
        append n $tbl([expr ($x & 0xFC) >> 2])
        append n $tbl([expr [expr ($x & 0x3) << 4] | [expr ($y & 0xF0) >> 4]])
        append n $tbl([expr [expr ($y & 0xF) << 2] | [expr ($z & 0xC0) >> 6]])
        append n $tbl([expr 0x3F & $z])
    }
    
    return "[string range $n 0 $trim]$tag"
}

proc escape { x } {
    global map
    regsub -all \[^a-zA-Z0-9\] $x {$map(&)} x
    regsub -all \n $x {\\n} x
    regsub -all \t $x {\\t} x
    regsub -all {[][{})\\]\)} $x {\\&} x
    return [subst $x]
} 

proc execProgram { xName cmd } {
    upvar $xName x
    
    set altered [list]
    
    foreach i $cmd {
	if [string equal $x(password) $i] {
	    lappend altered "********"
	} else {
	    lappend altered $i
	}
    }

    puts stdout $altered

    set rc [catch [linsert $cmd 0 exec] result]

    if [string length $result] {
	if { $rc } {
	    puts stderr $result
	} else {
	    puts stdout $result
	}
    }

    return $rc
}

proc fetchData { sock } {
    global exitMsg
    global recv
    global sockStatus
    global status
    
    if [catch {gets $sock line} result] {
	set result $status(bad)
    } else {
	switch -exact -- [expr $result] {
	    -1 {
		set result $status(eof)
	    }
	    0 {
		set result $status(ready)
		if [fblocked $sock] {
		} else {
		    lappend recv($sock) $line
		}
	    }
	    default {
		set result $status(ready)
		lappend recv($sock) $line
		foreach i $exitMsg($sock) {
		    if [regexp $i $line] {
			#
			# I have noticed that the admin server takes
			# a minute to close the result pipe (thus
			# we wait a long time for the eof trigger)
			# for servlet based "scripts".
			# Consequently, if I see an "exitMsg"
			# come through the pipe, I'll "force" an
			# exit. rwagner Jan 7, 2003.
			#
			set result $status(exitMsg)
		    }
		}
	    }
	}
    }

    set sockStatus($sock) $result
}

proc fetchSetupID { xName path } {
    upvar $xName x
    
    if [file exists $path] {
	set cwd [pwd]
	cd [file dirname $path]
	set classPath [pwd]
	cd [file join $x(root)]
	set cmd [list exec [file join [pathToJava x]] [javaLibraryPath x] -cp $classPath [dropClass [file tail $path]] -id]
	if [catch $cmd result] {
	    cd $cwd
	    error $result
	}
	cd $cwd	    
    } else {
	error "$path does not exist."
    }
    
    return $result
}

proc findAdmin { nwd adminMask } {
    set cwd [pwd]
    
    cd $nwd
    
    if [catch {glob $adminMask} result] {
	cd $cwd
	error "Could not locate anything that matched $adminMask"
    } else {
	cd $cwd
	if [expr [llength $result] == 1] {
	} else {
	    error "Too many files matched $adminMask"
	}
    }
    
    return [file join $nwd $result]
}

proc findAdminInstaller { xName } {
    upvar $xName x
    
    return [findAdmin [file join $x(user.dir) admin_server] "*.class"]
}

proc findAdminUninstaller { xName } {
    upvar $xName x
    
    return [findAdmin [file join $x(root) setup] "uninstall_*.class"]
}

proc fixPermissions { dMask fMask } {
    if [catch {glob *} fList] {
    } else {
	foreach i $fList {
	    set perm [file attributes $i -permissions]
	    if [file isdirectory $i] {
		file attributes $i -permissions [expr $perm | $dMask]
		cd $i
		fixPermissions $dMask $fMask
		cd ..
	    } else {
		file attributes $i -permissions [expr $perm | $fMask]
	    }
	}
    }
}

proc getAdminPid { xName url } {
    upvar $xName x
    
    set result [sendurl x $url [list "^pid"]]
    
    foreach i $result {
	set j [string tolower $i]
	if [regexp "^pid: \[0-9]*" $j] {
	    return $j
	}
    }
    
    return "unknown"
}

proc javaLibraryPath { xName } {
    upvar $xName x

    set jlp "-Djava.library.path=[file join $x(root) setup dps lib]"

    return $jlp
}

proc javaSeperator { } {
    if [unix] {
	set rc ":"
    } else {
	set rc ";"
    }

    return $rc
}

proc ldapAdd { xName ldif } {
    upvar $xName x

    set rc [expr -1]

    if [file exists $ldif] {
	set ldapadd [file join $x(root) shared bin [cmd ldapadd]]
	set ldapaddFound [file exists $ldapadd] 
	if {$ldapaddFound} {
	} else {
	    set ldapmodify [sharedBin x ldapmodify]
	    file copy $ldapmodify $ldapadd
	}	
	set cwd [pwd]
	#
	# ldapadd is linked so that if it is executed
	# with shared/bin as the current working directory
	# it will be able to locate its libraries.
	#
	cd [file join $x(root) shared bin]
	set cmd [list [cmd ./ldapadd] \
		-h $x(cdsHost) \
		-p $x(cdsPort) \
		-D $x(user) \
		-w $x(password) \
		-f $ldif \
		]
	set rc [execProgram x $cmd]
	cd $cwd   
	if {$ldapaddFound} {
	} else {
	    file delete $ldapadd
	}
    } else {
	puts stderr "$ldif not found."
    }

    return $rc
}

proc ldapModify { xName ldif } {
    upvar $xName x

    set rc [expr -1]

    if [file exists $ldif] {
	set cwd [pwd]
	#
	# ldapmodify is linked so that if it is executed
	# with shared/bin as the current working directory
	# it will be able to locate its libraries.
	#
	cd [file join $x(root) shared bin]
	set cmd [list [sharedBin x ldapmodify] \
		-h $x(cdsHost) \
		-p $x(cdsPort) \
		-D $x(user) \
		-w $x(password) \
		-f $ldif \
		]
	set rc [execProgram x $cmd]
	cd $cwd
    } else {
	puts stderr "$ldif not found."
    }

    return $rc
}

proc Linux { } {
    global tcl_platform

    return [string equal $tcl_platform(os) Linux]
}

proc mkdir { name perm } {
    if [catch {file mkdir $name} result] {
    } else {
	catch {exec chmod $perm $name} result
    }
}

proc osName { } {
    global tcl_platform

    if [unix] {
	if [Solaris] {
	    return "Solaris"
	}
	return $tcl_platform(os)
    }

    if [Win2K] {
	return "Win2K"
    }

    if [WinNT] {
	return "WinNT"
    }

    error "Unknown osName $tcl_platform(os)"
}

proc osType { } {

    if [unix] {
	set rc "Unix"
    } else {
	set rc "Windows"
    }

    return $rc
}

proc pathToJava { xName } {
    upvar $xName x
    return [file join $x(java.home) bin [cmd java]]
}

proc restartAdmin { xName } {
    upvar $xName x

    if {$x(okToRestartAdmin)} {
	set x(v) [expr 1]
	set x(wait) [expr 60]

	set pid [getAdminPid x "/admin-serv/tasks/Operation/Restart?op=getpid"]
		
	set i [expr 0]
	
	while {[expr [string compare "unknown" $pid] == 0]} {
	    incr i
	    if {[expr $i > 10]} {
		error "Admin Server refused to disclose its pid!"
	    }
	    after [expr 3 * 1000]
	    set pid [getAdminPid x "/admin-serv/tasks/Operation/Restart?op=getpid"]
	}
	
	getAdminPid x "/admin-serv/tasks/Operation/Restart?op=restart"

	after [expr 6 * 1000]
	
	set npid [getAdminPid x "/admin-serv/tasks/Operation/Restart?op=getpid"]
		
	set i [expr 0]
	
	while {[expr [string compare $pid $npid] == 0 || [string compare "unknown" $npid] == 0]} {
	    incr i
	    if {[expr $i > 30]} {
		error "Admin Server refused to restart!"
	    }
	    after [expr 6 * 1000]
	    set npid [getAdminPid x "/admin-serv/tasks/Operation/Restart?op=getpid"]
	}
    }
}

proc rmdir { dName } {

    if [file isdirectory $dName] {
	set cwd [pwd]
	cd $dName
	set dName [pwd] ; # force dName to be an absolute path
	if [catch {glob *} filelist] {
	} else {
	    foreach i $filelist {
		rmdir [file join $dName $i]
	    }
	    cd $dName
	}
	if [string equal $cwd [pwd]] {
	    puts stderr "$dName not removed as it is busy."
	} else {
	    if [catch {glob *} filelist] {
		cd $cwd
		puts stdout "$dName empty and removed."
		catch {file delete -- $dName} result
	    } else {
		cd $cwd
		puts stdout "$dName not empty."
	    }
	}
    }
}

proc send { verbose sock text} {
    global recv

    if {$verbose} {
	lappend recv($sock) $text
    }

    puts $sock $text
}

proc sendUrl { xName url exitMessages} {
    global exitMsg
    global recv
    global sockStatus
    global status
    upvar $xName x
    
    set sock [socket -async $x(fullHostname) $x(adminPort)]
    set sockStatus($sock) [expr 0]
 
    set id [after [expr $x(wait) * 1000] [list twiddle $sock 1]]
    fileevent $sock w [list twiddle $sock 2]
   
    vwait sockStatus($sock)
    
    after cancel $id
    
    if [expr $sockStatus($sock) > 1] {
    } else {
	set result "Connection to $x(fullHostname) $x(adminPort) timed out."
	puts stderr $result
	error $result
    }
    
    set exitMsg($sock) $exitMessages
    set recv($sock) [list "Begin time: [clock format [clock seconds]] $url"]
    
    fileevent $sock w [list]
    fconfigure $sock -buffering line
    
    send $x(v) $sock "GET $url HTTP/1.1"
    send $x(v) $sock "Host: $x(fullHostname)"
    send $x(v) $sock "User-Agent: Tcl/Tk dpsSetup.tcl"
    send $x(v) $sock "Authorization: BASIC [encode "$x(user):$x(password)"]"
    send $x(v) $sock ""
    flush $sock

    set sockStatus($sock) $status(ready)
    fileevent $sock readable [list fetchData $sock]
    
    after [expr $x(wait) * 1000] [list set sockStatus($sock) $status(timeout)]
    
    while {$sockStatus($sock) == $status(ready)} {
	vwait sockStatus($sock)
    }
    
    set result $recv($sock)

    lappend result "End time: [clock format [clock seconds]] $url"
    
    unset sockStatus($sock)
    unset recv($sock)
    unset exitMsg($sock)
    
    catch {close $sock} junk
    
    if $x(v) {
	foreach i $result {
	    puts stdout "$i"
	}
    }
    
    return $result
}

proc sendurl { xName url {exitMessages [list]}} {
    upvar $xName x
    
    set i [expr 0]
    
    while {[expr [expr $i < 3] && [expr [catch {sendUrl x $url $exitMessages} result] != 0]]} {
	puts stdout "Retry for: $url"
	incr i
	after [expr 3 * 1000]
    }
    
    return $result
}

proc setupReplaceLdif { xName ldif } {
    upvar $xName x

    set rc [expr -1]

    if [file exists $ldif] {
	set cmd [list [file join $x(java.home) bin java] \
		-cp \
		[classPathToString [list $x(java.class.path) \
		[file join $x(root) java ldapjdk.jar] \
		[file join $x(root) setup dps dps52Setup.jar] \
		]] \
		com.sun.dps.importLdif \
		-host $x(cdsHost) \
		-ldif $ldif \
		-password $x(password) \
		-port $x(cdsPort) \
		-user $x(user) \
		]
	set rc [execProgram x $cmd]
	set rc [expr 0]
    } else {
	puts stderr "$ldif not found."
    }

    return $rc
}

proc setupUpdateLdif { xName ldif } {
    upvar $xName x
    return [setupReplaceLdif x $ldif]
}

proc sharedBin { xName cmdBase } {
    upvar $xName x

    set command [cmd $cmdBase]

    if [spanInstall x] {
	set temp [file join $x(root) shared bin $command]
	if [file exists $temp] {
	    set command $temp
	} else {
	    if [catch {exec pkginfo -r SUNWasvu} asvuDir] {
		error "Can't locate $command"
	    } else {
		set temp [file join $asvuDir usr sadm mps admin v5.2 shared bin $command]
		if [file exists $temp] {
		    set command $temp
		} else {
		    error "SUNWasvu didn't install $command"
		}
	    }
	}
    } else {
	set command [file join $x(root) shared bin $command]
    }

    return $command
}

proc snmpInstall { xName } {
    upvar $xName x
    #
    # This code test to see if our bits were sourced from a Solaris
    # Native Mode Package install.
    #
    
    #
    # Note here SNMP is an abbreviation for Solaris Native Mode Package
    #
    
    set snmpBits [expr 0]

    if [Solaris] {
	
	if [catch {exec pkginfo -r SUNWasvcp} adminDir] {
	    #
	    # Admin Server SNMP package was not installed thus
	    # we should assume that our package sourced libraries
	    # are missing as well.
	    #
	} else {
	    if [file exist $adminDir] {
		if [catch {exec pkginfo -r SUNWdps} dpsDir] {
		    #
		    # DPS has not been installed via SNMP
		    #
		} else {
		    #
		    # There isn't anything stopping someone from
		    # installing both SNMP and Setupsdk based packages.
		    # So we look to see where the bits we are using are
		    # from....
		    #
		    set snmpBits [expr [string equal $x(root) $x(currentInstallDirectory)] == 0]
		}
	    } else {		
		#
		# Product registry thinks Admin Server is installed
		# but we don't see it in the file system
		#
	    }
	}
    }
	
    return $snmpBits
}

#
# A span install is where the server root does not possess
# a local copy of the executables, scripts, jars, etc.
#
# True whenever server root <> currentInstallDirctory
#
proc spanInstall { xName } {
    upvar $xName x
    
    set spanBits [snmpInstall x]

    if {$spanBits} {
    } else {
	set spanBits [expr [string equal $x(root) $x(currentInstallDirectory)] == 0]
    }
	
    return $spanBits
}
    
proc Solaris { } {
    global tcl_platform

    return [string equal $tcl_platform(os) SunOS]
}

proc startDps { xName } {
    upvar $xName x

    set x(v) [expr 1]
    set x(wait) [expr 60]
    sendurl x "/$x(instance)/tasks/operation/start?idarroot=[escape $x(instanceRoot)]" [list "^nmc_status"]
    
}

proc stopDps { xName } {
    upvar $xName x

    set x(v) [expr 1]
    set x(wait) [expr 60]
    sendurl x "/$x(instance)/tasks/operation/stop?idarroot=[escape $x(instanceRoot)]" [list "^nmc_status"]
    
}

proc touch { fName {perm 0644} } {

    if [file exists $fName] {
	close [open $fName "a"]
    } else {
	close [dpsWriteOpen $fName $perm]
    }
}

proc twiddle { sock i } {
    global sockStatus

    set sockStatus($sock) [expr $sockStatus($sock) | $i]
}

proc unix { } {
    global tcl_platform
    
    return [string equal $tcl_platform(platform) unix]
}

proc usage { msg } {
    puts stderr $msg
    puts stderr ""
    puts stderr "Usage:"
    puts stderr "dpsSetup.tcl <ContextFile> <ScriptFile>"
    puts stderr ""
}

proc Win2K { } {
    global tcl_platform
    
    set rc [Windows]
    
    if {$rc} {
	set rc [string equal $tcl_platform(osVersion) "5.0"]
    }
    
    return $rc
}

proc Windows { } {
    return [expr 0 == [unix]]
}

proc WinNT { } {
    global tcl_platform
    
    set rc [Windows]
    
    if {$rc} {
	set rc [string equal $tcl_platform(osVersion) "4.0"]
    }
    
    return $rc
}

proc unscramble {string} {

	set theResult ""


        if [string match "{}*" $string] {

        set i 0

        foreach char   {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h\
        i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /} {
                set theArray($char) $i
                incr i
        }

        set theGroup 0
        set Bits 18
        foreach char [split [string trim $string "{}"] {}] {
                if {[string compare $char "="]} {
                        set theBits $theArray($char)
                        set theGroup [expr {$theGroup | ($theBits << $Bits)}]
                        if {[incr Bits -6] < 0} {
                                scan [format %06x $theGroup] %2x%2x%2x t1 t2 t3
                                append theResult [format %c%c%c $t1 $t2 $t3]
                                set theGroup 0
                                set Bits 18
                        }
                } else {
                        scan [format %04x $theGroup] %2x%2x t1 t2
                        if {$Bits == 6} {
                                append theResult [format %c $t1]
                        } elseif {$Bits == 0} {
                                append theResult [format %c%c $t1 $t2]
                        }
                        break
                }
        }

        } else {
                set theResult $string
        }

        return $theResult
}

if [catch {dpsSetup $argv} result] {
    puts stderr "dpsSetup failed with:"
    puts stderr $result
    set rc -1
} else {
    set rc $result
}

# puts stdout "return code: $rc"

exit $rc
