#!/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 assertASFootprint { path {msg [list]} } {
    lappend msg "While examing Admin Server viability:"
    foreach i [list \
	    [file join $path] \
	    [file join $path bin] \
	    [file join $path java jars] \
	    [file join $path lib] \
	    [file join $path setup] \
	    [file join $path admin-serv config] \
	    ] {
	assertDirExistWritable $i $msg
    }
    assertFileExistReadable [file join $path admin-serv config adm.conf] $msg
    assertFileExistWritable [file join $path admin-serv config jvm12.conf] $msg
    assertOwner $path $msg

    return $path
}

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 assertCIDFootprint { path {msg [list]} } {
    assertDirExistReadable $path $msg
    set dpsPath [file join $path bin dps install script]
    set msg [lappend msg \
	    "It seems that some of DPS prerequisite components have not been installed." \
	    "In such cases, quickstart isn't a viable procedure. Reason:" \
	    ]

    assertDirExistReadable $dpsPath $msg

    set cwd [pwd]
    cd $dpsPath

    if [catch {glob dps*ins.tcl} result] {
	cd $cwd
	error [lappend msg "Could not locate support scripts at:" $dpsPath]
    } else {
	cd $cwd
	foreach i $result {
	    assertFileExistReadable [file join $dpsPath $i] $msg
	}
    }

    assertFileExistReadable [propertyName $path] $msg

    return $path
}

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

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

proc assertDirExistWritable { path {msg [list]} } {
    if [file writable [assertDirExistReadable $path $msg]] {
    } else {
	error [lappend msg "Permissions don't allow write access to $path."]
    }
    
    return $path
}

proc assertDirNonexistant { path {msg [list]} } {
    if [file exist $path] {
	error [lappend msg "$path already exists."]
    }

    return $path
}

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 assertFileExistWritable { path {msg [list]} } {
    if [file writable [assertFileExistReadable $path $msg]] {
    } else {
	error [lappend msg "Permissions don't allow write access to $path."]
    }
    
    return $path
}

proc assertNewDirWritable { path {msg [list]} } {
    assertDirExistWritable [file dirname $path] $msg
    assertDirNonexistant $path $msg

    return $path
}

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

    if [catch {socket $host $port} result] {
    } else {
	close $result
	error [lappend msg "$host:$port is already in use."]
    }

    return $port
}

proc assertNonBusyPort { port {msg [list]} } {
    assertPort $port $msg
    assertNonBusyHostPort localhost $port $msg

    return $port
}

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 quickstart 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 configure { xName } {
    upvar $xName x
    set result [execInstall x dps52svr]

    append result [execInstall x dps52cfg]
    append result [execInstall x dps52ins]

    return $result
}

proc execInstall { xName cName} {
    upvar $xName x
    global errorCode
    
    set cmd [list \
	    $x(tclsh) \
	    [file join $x(-cid) bin dps install script dpsSetup.tcl] \
	    $x(quickstart) \
	    [file join $x(-cid) bin dps install script $cName] \
	    ]

    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 $result
	}
    }

    return $result
}

proc cmd { x } {
    global tcl_platform

    if [string equal "unix" $tcl_platform(platform)] {
    } else {
	append x ".exe"
    }

    return $x
}

proc noedit { x {msg [list]} } {
    return $x
}

proc processADMCONF { xName } {
    upvar $xName x
    
    set iName [file join $x(-serverroot) admin-serv config adm.conf]
    
    set iFile [open $iName r]
    
    set isie ""
    set ldapHost ""
    set ldapPort ""
    set port ""
    set siepid ""
    
    while {[gets $iFile line] >= 0} {
	if [regexp -nocase "^isie\:" $line] {
	    regexp -nocase "^isie\:\[ \t\]*(.+)" $line a isie
	} else {
	    if [regexp -nocase "^ldapHost\:" $line] {
		regexp -nocase "^ldapHost\:\[ \t\]*(.+)" $line a ldapHost
	    } else {
		if [regexp -nocase "^ldapPort\:" $line] {
		    regexp -nocase "^ldapPort\:\[ \t\]*(.+)" $line a ldapPort
		} else {
		    if [regexp -nocase "^port\:" $line] {
			regexp -nocase "^port\:\[ \t\]*(.+)" $line a port
		    } else {
			if [regexp -nocase "^siepid\:" $line] {
			    regexp -nocase "^siepid\:\[ \t\]*(.+)" $line a siepid
			}
		    }
		}
	    }
	}
    }
    
    close $iFile
    
    if [string length $isie] {
    } else {
	error [list "Could not devine hostname, fullHostname and domain from isie in $iName"]
    }
    
    if [string length $ldapHost] {
	set x(cdsHost) $ldapHost
    } else {
	error [list "Could not find ldapHost in $iName"]
    }
    
    if [string length $ldapPort] {
	set x(cdsPort) $ldapPort
    } else {
	error [list "Could not find ldapPort in $iName"]
    }

    assertBusyHostPort $x(cdsHost) $x(cdsPort) [list "While attempting to contact CDS host:"]

    if [string length $port] {
	set x(adminPort) $port
    } else {
	error [list "Could not find Admin Server listen port in $iName"]
    }

    assertBusyPort $x(adminPort) [list "While attempting to contact host Admin Server:"]

    if [string length $siepid] {
    } else {
	if [string length $x(-userID)] {
	    set siepid $x(-userID)
	}
    }

    if [string length $siepid] {
    } else {
	if [string length $x(-user)] {
	    set siepid [userID $x(-user)]
	}
    }

    if [string length $siepid] {
	set x(siepid) $siepid
    } else {
	error [list "Could not find siepid in $iName"]
    }
    
    set i [string last "," $isie]
    set j [string last "," $isie [expr $i - 1]]
    set k [string last "," $isie [expr $j - 1]]
    set host [string trim [string range $isie [expr $k + 1] [expr $j - 1]]]
    set x(fullHostname) [string range $host [expr [string first "=" $host] + 1] end]
    set x(hostname) [string range $x(fullHostname) 0 [expr [string first "." $x(fullHostname)] - 1]]
    set domain [string trim [string range $isie [expr $j + 1] [expr $i - 1]]]
    set x(domain) [string range $domain [expr [string first "=" $domain] + 1] end]
}

proc processProperties { xName } {
    upvar $xName x
    
    set iName [propertyName $x(-cid)]
    
    set iFile [open $iName r]
    
    set DPS_BUILD ""
    set DPS_REVISION ""
    set DPS_SECURITY ""
    
    while {[gets $iFile line] >= 0} {
	if [regexp "^DPS_BUILD=" $line] {
	    regexp "^DPS_BUILD=\[ \t\]*(.+)" $line a DPS_BUILD
	} else {
	    if [regexp "^DPS_REVISION=" $line] {
		regexp "^DPS_REVISION=\[ \t\]*(.+)" $line a DPS_REVISION
	    } else {
		if [regexp "^DPS_SECURITY=" $line] {
		    regexp "^DPS_SECURITY=\[ \t\]*(.+)" $line a DPS_SECURITY
		} else {
		}
	    }
	}
    }

    close $iFile

    if [string length $DPS_BUILD] {
	set x(build) $DPS_BUILD
    } else {
	error [list "Did not find DPS_BUILD in $iName"]
    }

    if [string length $DPS_REVISION] {
	set x(revision) $DPS_REVISION
    } else {
	error [list "Did not find DPS_REVISION in $iName"]
    }

    if [string length $DPS_SECURITY] {
	set x(security) $DPS_SECURITY
    } else {
	error [list "Did not find DPS_SECURITY in $iName"]
    }
}

proc propertyName { path } {
    return [file join $path setup dps locale resources DpsSetupResources.properties]
}

proc quickstart { xName } {
    upvar $xName x
    global tcl_platform

    
    set x(tclsh) [file join $x(-cid) bin tcl8.2 [cmd tclsh]]

    set instance "dps-$x(hostname)"

    set x(instance) $instance
    set i [expr 0]

    while {[file exist [file join $x(-serverroot) $x(instance)]]} {
	incr i
	set x(instance) "$instance$i"
    }

    set x(suffix) [string range $x(instance) 4 end]

    set x(quickstart) [file join $x(-serverroot) "quickstart.$x(instance).tcl"]

    # Write context
    writeContext x $x(quickstart) [expr 1]

    set rc [catch {configure x} result]

    catch {writeContext x [file join $x(-serverroot) $x(instance) uninstallContext.tcl] [expr 0]} ignore

    file delete $x(quickstart)

    if {$rc} {
	error $result
    }

    # upgrade serverroot
    set synccmd [list \
	    $x(tclsh) \
	    [file join $x(-serverroot) bin dps install script sync-dps.tcl] \
            -syncType upgrade -cid $x(-cid) -serverroot $x(-serverroot) -verbose \
	    ]
    set rc [catch [linsert $synccmd 0 exec] result]

    if {$rc} {
	error $result
    }

    # create symlinks for on-line help

    if [string equal "unix" $tcl_platform(platform)] {

    # Make sure it is needed
    set manualdir [file join $x(-serverroot) manual]
    if [catch {file readlink ${manualdir}} result] {

    # Get the list of dps locales available
    set iList {}
    set dpshelpdir [file join $x(-cid) manual]
    set theCwd [pwd]
    cd $dpshelpdir
    if [catch {glob *} iList] {
    } else {
	cd $theCwd
	foreach i $iList {
	  set aLocale [file join $x(-cid) manual $i dps]
	  if [file exist $aLocale] {
		# candidate for symlink
		# Make sure the locale directory configured in the serverroot.
		# if not, create it
		set theTarget [file join $manualdir $i]
	  	if [file exist $theTarget] {
		} else {
		   if [catch {file mkdir $theTarget} result] {
			error $result
		   }
		}
			
		set theTargetLocale [file join $theTarget dps]
		# create the sym link
		if [file exist $theTargetLocale] {
                } else {
		set cmdhelp [list exec ln -s ${aLocale} ${theTargetLocale}]
                if [catch $cmdhelp result] {
        		error $result
    		}
		}
	}
    }
   }
   }
   }
		
    return $result
}

proc userID { x } {
    if [regexp -nocase "^uid=" $x] {
	regexp -nocase "^uid=(.+)" $x a id
	set id [string range $id 0 [expr [string first "," $id] - 1]]
    } else {
	set id ""
    }
    
    return $id
}

proc writeContext { xName path isInstaller } {
    upvar $xName x

    set out [open $path w 0600]

    puts $out "proc init { xName } {"
    puts $out ""
    puts $out "  upvar \$xName x"
    puts $out ""
    puts $out "  set x(adminPort) \"$x(adminPort)\""
    puts $out "  set x(build) \"$x(build)\""
    puts $out "  set x(cdsHost) \"$x(cdsHost)\""
    puts $out "  set x(cdsPort) \"$x(cdsPort)\""
    puts $out "  set x(currentInstallDirectory) \"$x(-cid)\""
    puts $out "  set x(domain) \"$x(domain)\""
    puts $out "  set x(dpsPort) \"$x(-listen)\""
    puts $out "  set x(fullHostname) \"$x(fullHostname)\""
    puts $out "  set x(hostname) \"$x(hostname)\""
    puts $out "  set x(isInstaller) \[expr [expr $isInstaller]\]"
    puts $out "  set x(isUninstaller) \[expr [expr $isInstaller == 0]\]"
    puts $out "  set x(instance) \"$x(instance)\""
    puts $out "  set x(java.home) \"[file join $x(-serverroot) bin base jre]\""
    puts $out "  set x(java.class.path) \"[file join $x(-cid) setup]\""
    puts $out "  set x(okToRestartAdmin) \[expr 1\]"
    puts $out "  set x(password) \"[scramble $x(-password)]\""
    puts $out "  set x(revision) \"$x(revision)\""
    puts $out "  set x(root) \"$x(-serverroot)\""
    puts $out "  set x(security) \"$x(security)\""
    puts $out "  set x(suffix) \"$x(suffix)\""
    puts $out "  set x(tclsh) \"$x(tclsh)\""
    puts $out "  set x(user) \"$x(-user)\""
    puts $out "  set x(userID) \"$x(-userID)\""
    puts $out "  set x(user.dir) \"[pwd]\""
    puts $out ""
    puts $out "}"

    close $out
}

  proc scramble {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($i) $char
                incr i
        }
        set theResult "{}"
        set theState 0
        foreach {c} [split $string {}] {
        scan $c %c x
        switch [incr theState] {
            1 { append theResult $theArray([expr { ($x >>2) & 0x3f}]) }
            2 { append theResult $theArray([expr { (($previous << 4) & 0x30) | (($x >> 4) & 0xf)}]) }
            3 { append theResult $theArray([expr {(($previous << 2) & 0x3c) | (($x >> 6) & 0x3)}])
                append theResult $theArray([expr {($x & 0x3f)}])
                set theState 0}
        }
        set previous $x
        }
        # don't forget trailing bytes if any
        set x 0
        switch $theState {
                0 {}
                1 { append theResult $theArray([expr {(($previous << 4) & 0x30)}])  == }
                2 { append theResult $theArray([expr {(($previous << 2) & 0x3c)}])  =  }
        }
        return $theResult
    }


#######
#
# main
#
#######

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
    }
}

set edit(-cid) assertCIDFootprint
set edit(-listen) assertNonBusyPort
set edit(-password) "noedit"
set edit(-serverroot) assertASFootprint
set edit(-user) "noedit"
set edit(-userID) "noedit"

set edit(-file) "noedit"

set defParm(-cid) -serverroot

foreach i [array names edit] {
    lappend parms $i
    set x($i) ""
}

set knob(-verbose) [expr 0]

foreach i [array names knob] {
    lappend parms $i
    set x($i) $knob($i)
}

set optional [list -cid -password -file]
set required [list -listen -serverroot -userID]

foreach i $required {
    set x($i) ""
}

set x(-password) ""
set x(-file) ""

set errmsg [list]
set mode ""
set usage [expr 0]

foreach i $argv {
    if [string length $mode] {
	if [string length $x($mode)] {
	    lappend errmsg [list "Parameter $mode stipulated multiple times."]
	} else {
	    if [catch {$edit($mode) $i [list "For parameter $mode:"]} result] {
		lappend errmsg $result
		set x($mode) $i
	    } else {
		set x($mode) $result
	    }
	}
	set mode ""
    } else {
	if [expr [lsearch $parms $i] < 0] {
	    lappend errmsg [list "Unknown parm $i."]
	    incr usage
	} else {
	    if [info exist knob($i)] {
		set x($i) [expr $knob($i) == 0]
	    } else {
		set mode $i
	    }
	}
    }
}

foreach i [array names defParm] {
    if [string length $x($i)] {
    } else {
	set j $defParm($i)
	if [string length $x($j)] {
	    if [catch {$edit($i) $x($j) [list "While editing default value for $i:"]} result] {
		lappend errmsg $result
	    } else {
		set x($i) $result
	    }
	}
    }
}

set missing [list]

foreach i $required {
    if [string length $x($i)] {
    } else {
	lappend missing $i
    }
}

if [llength $missing] {
    lappend errmsg [list "Required parameter(s) missing: $missing."]
    set usage [expr 1]
}

if [string length $x(-password)] {
# password takes precedence over file for compatibility
} else {
if [string length $x(-file)] {
    set themsg [list]
    if [catch {assertFileExistReadable $x(-file) $themsg } result ] {
	lappend errmsg $result
    } else {
    	set fd [open $x(-file) r]
    	gets $fd line
    	if [string length $line] {
		set x(-password) $line
    	} else {
    		lappend errmsg [list "Password file empty. Password required."]
    	}
    }
} else {
	lappend errmsg [list "Parameter -password or -file is required and missing."]
	incr usage
}
}

if [llength $errmsg] {
} else {
    if [catch {processADMCONF x} result] {
	lappend errmsg $result
    } else {
	if [string length $x(-user)] {
	} else {
	    set x(-user) "uid=$x(-userID), ou=Administrators, ou=TopologyManagement, o=NetscapeRoot"
	}
    }
    if [catch {processProperties x} result] {
	lappend errmsg $result
    }
}

if [llength $errmsg] {
} else {
    foreach i $parms {
	if [expr [lsearch $optional $i] < 0] {
	    if [string length $x($i)] {
	    } else {
		lappend errmsg [list "Parameter $i is required and missing."]
		incr usage
	    }
	}
    }
}



if {$usage} {
    lappend errmsg [list \
	    "Usage:" \
	    "quickstart.tcl  \[-cid path\] -serverroot path" \
	    "\t\t-listen port" \
	    "\t\t-password | -file" \
	    "\t\t-userID userID \[-user fullUserDN\]" \
	    "\t\t\[-verbose\]" \
	    "" \
	    ]
}

if [llength $errmsg] {
    foreach i $errmsg {
	foreach j $i {
	    puts stderr $j
	}
    }
    exit 1
}

puts stdout "Launching installers... please wait..."

# UNIX: If current login is root, then su as the serverroot owner

set x(tclsh) [file join $x(-cid) bin tcl8.2 [cmd tclsh]]


if [string equal "unix" $tcl_platform(platform)] {
    set cwd [pwd]
    set rcmd "cd $cwd; $x(tclsh) $argv0 $argv"
    if { $launched_as_root == 1 } {
	# quickstart ran as root
	if [file owned $x(-serverroot)] {
	} 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 - ...; quickstart.tcl'
	    # that will relaunched this given script as a different user

	    set surc [catch {exec su - [file attributes [file join $x(-serverroot)] -owner] -c "$rcmd"} suresult]
	    exit $surc
	}
    }
}

cd $x(-serverroot)

if [catch {quickstart x} result] {
    puts stderr $result
    puts stderr "Installation failed."
    exit 1
}

if {$x(-verbose)} {
    puts stdout $result
    puts stdout ""
}

puts stdout "Installation for $x(instance) completed."

exit 0
