#!/bin/sh
# \
	exec tclsh "$0" ${1+"$@"}
#
# Copyright C 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
#

proc assertBusyHostPort { host port {msg [list]} } {
    assertPort $port $msg

    if [catch {socket $host $port} result] {
	error [lappend msg "Connections are not being accepted at $host:$port."]
    } else {
	close $result
    }

    return $port
}

proc assertBusyPort { port {msg [list]} } {
    assertBusyHostPort localhost $port $msg

    return $port
}

proc assertExist { path {msg [list]} } {
    
    if [file exists $path] {
    } else {
	error [lappend msg "$path does not exist."]
    }
    
    return $path
}

proc assertFileExist { path {msg [list]} } {
    
    if [file isfile [assertExist $path $msg]] {
    } else {
	error [lappend msg "$path isn't a file."]
    }
    
    return $path
}

proc assertFileExistReadable { path {msg [list]} } {
    if [file readable [assertFileExist $path $msg]] {
    } else {
	error [lappend msg "Permissions don't allow read access to $path."]
    }
    
    return $path
}

proc assertOwner { path {msg [list]} } {
    global tcl_platform
    global argv0
    global argv
    global launched_as_root


    if [string equal "unix" $tcl_platform(platform)] {
	if { $launched_as_root == 1 } {
	    # no error if this script launched by root user
	} else {
	    if [file owned $path] {
		# no error if this script launched by serverroot owner
	    } else {
		set owner [file attributes [file join $path] -owner]
		lappend msg "You don't \"own\" $path."
		lappend msg "\n\nPlease log as $owner and run the following command: "
		lappend msg "$argv0 $argv"
		error $msg
	    }
	}
    }
    return $path
}

proc assertPort { port {msg [list]} } {
    set pattern "\[1-9\]\[0-9\]*"
    if [regexp "^$pattern\$" $port] {
    } else {
	error [lappend msg "The given port value of \"$port\" follow the pattern $pattern."]
    }

    if [expr $port > 65535] {
	error [lappend msg "Port numbers may not be greater that 65535."]
    }

    return $port
}

proc unscramble {string} {

        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
}

proc rminstance { argv xName } {
    upvar $xName x
    global errorCode
    global tcl_platform
    global argv0
    global env
    global launched_as_root

    switch [llength $argv] {
	0 {
	    error [list "Too few arguments. Expected a path to the context file."]
	}
	1 {
	    assertFileExistReadable $argv [list "While trying to access context file:"]
	    if [catch {source $argv} result] {
		error [list "$argv doesn't conformto expected format."]
	    }
	    if [catch {init x} result] {
		error [list "Could not initialize context."]
	    }
	
 	    #unscrmable password
	    set x(-password) [unscramble $x(password)]

	    assertBusyPort $x(adminPort) [list "While checking to see if Admin Server is running:"]
	    assertBusyHostPort $x(cdsHost) $x(cdsPort) [list "While checking to see if CDS host is running:"]
	    assertOwner $x(root) [list "While checking server root's ownership"]

	    # UNIX: If current login is root, then su as the serverroot owner
	    
	    if [string equal "unix" $tcl_platform(platform)] {
		set cwd [pwd]
		set rcmd "cd $cwd; $x(tclsh) $argv0 $argv"
		if { $launched_as_root == 1 } {
		    # rminstance ran as root
		    if [file owned $x(root)] {
		    } else {

			# and root is not the owner of serverroot then let's run as this owner

			# 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
		    }
		}
	    }
	    
	    puts stdout "Beginning uninstallation of [file join $x(root) $x(instance)]"
	    set cList [list dps52insUninstall dps52cfgUninstall dps52svrUninstall]
	    set cwd [pwd]
	    cd $x(root)
	    if [catch {glob dps-*} iList] {
	    } else {
		if [expr [llength $iList] > 1] {
		    set cList [lrange $cList 0 0]
		}
	    }
	    set context [file join $x(root) uninstallDpsContext.tcl]
	    if [file exist $context] {
		file delete $context
	    }
	    file copy $argv $context
	    foreach i $cList {
		set cmd [list \
			$x(tclsh) \
			[file join $x(currentInstallDirectory) bin dps install script dpsSetup.tcl] \
			$context \
			[file join $x(currentInstallDirectory) bin dps install script $i] \
			]
		if [catch [linsert $cmd 0 exec] result] {
		    if [string equal NONE [lindex $errorCode 0]] {
			#
			# The called routine exited with return code of 0
			# but somewhere along the line it wrote to stderr.
			# Thus exec doesn't think everything was ok, but
			# we only need to trust the return code for our
			# purposes. rwagner 04/30/2004
			#
		    } else {
			error [list $result]
		    }
		}
	    }
	    file delete $context
	}
	default {
	    error [list "Too many arguments. Please only specify a path to the context file."]
	}
    }
    
    cd $cwd
    return [list $result]
}

set launched_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 [catch {rminstance $argv x} result] {
    foreach i $result {
	puts stderr $i
    }
    exit 1
}

#foreach i $result {
#    puts stdout $i
#}

puts stdout "Completed uninstallation of [file join $x(root) $x(instance)]"

exit 0
