# $Id: version.tcl 1388 2008-03-07 09:57:59Z sergei $

custom::defvar options(reply_iq_version) 1 \
    [::msgcat::mc "Reply to version (jabber:iq:version) requests."] \
        -group IQ -type boolean

custom::defvar options(reply_iq_os_version) 1 \
    [::msgcat::mc "Include operating system info into a reply to version\
		  (jabber:iq:version) requests."] \
        -group IQ -type boolean

proc try_linux_version {distr file flag} {
    global linux_distribution

    if {![file exists $file]} {
	return
    }
    if {![file readable $file]} {
	set linux_distribution $distr
	return
    }
    set fd [open $file r]
    set content [read $fd]
    close $fd
    set last [string first "\n" $content]
    if {$last < 0} {
	set last end
    } else {
	set last [expr {$last - 1}]
    }
    set line [string range $content 0 $last]

    switch -- $flag {
	file { set linux_distribution $line }
	append { set linux_distribution "$distr $line" }
    }
}

# NOTE: lsb_release on Debian Etch is known to dump some complaints to
# stderr is some LSB modules are not available, so we rely only on the
# existence of lsb_release and its the return code.
proc get_lsb_info {} {
    if {[catch {exec lsb_release -a 2>/dev/null} info]} {
        return {}
    }

    foreach line [split $info \n] {
	foreach {key val} [split $line :] {
	    set fields([string tolower $key]) [string trim $val]
	}
    }

    foreach key {description release codename} {
        if {[info exists fields($key)]} {
	    append out "$fields($key) "
	}
    }

    return [string trim $out]
}

proc guess_linux_distribution {} {
    global linux_distribution

    if {[info exists linux_distribution] && $linux_distribution != {}} {
	return $linux_distribution
    }

    # First, let's see if we're on a LSB-compatible system:
    set linux_distribution [get_lsb_info]
    if {$linux_distribution != {}} { return $linux_distribution }

    foreach {distr file flag} { \
	"SuSE Linux"	    /etc/SuSE-release	    file \
	"Debian GNU/Linux"  /etc/debian_version	    append \
	"ASPLinux"          /etc/asplinux-release   file \
	"Alt Linux"	    /etc/altlinux-release   file \
	"PLD Linux"         /etc/pld-release	    file \
	"Gentoo Linux"	    /etc/gentoo-release	    file \
	"Mandrake Linux"    /etc/mandrake-release   file \
	"RedHat Linux"	    /etc/redhat-release	    file \
	"Conectiva Linux"   /etc/conectiva-release  file \
	"Slackware Linux"   /etc/slackware-version  append \
	"Arch Linux"	    /etc/arch-release	    file} {

	try_linux_version $distr $file $flag

	if {[info exists linux_distribution] && $linux_distribution != {}} {
	    return $linux_distribution
	}
    }

    set linux_distribution Linux
    return $linux_distribution
}

proc guess_windows_version {} {
    global tcl_platform

    switch -- $tcl_platform(os) {
	"Win32s" {
	    return {Windows 3.1}
	}
	"Windows 95" {
	    switch -- $tcl_platform(osVersion) {
		4.0  { return {Windows 95} }
		4.10 { return {Windows 98} }
		4.90 { return {Windows ME} }
		default { return [list $tcl_platform(os) $tcl_platform(osVersion)] }
	    }
	}
	"Windows NT" {
	    switch -- $tcl_platform(osVersion) {
		5.0 { return {Windows 2000}  }
		5.1 { return {Windows XP}    }
		5.2 { return {Windows 2003}  }
		6.0 { return {Windows Vista} }
		default { return [list $tcl_platform(os) $tcl_platform(osVersion)] }
	    }
	}
	default {
	    return [list $tcl_platform(os) $tcl_platform(osVersion)]
	}
    }
}

proc iq_version {connid from lang child} {
    global tkabber_version toolkit_version tcl_platform
    variable options

    if {!$options(reply_iq_version)} {
	return {error cancel service-unavailable}
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set restags [list \
		     [jlib::wrapper:createtag name -chdata Tkabber] \
		     [jlib::wrapper:createtag version -chdata \
			  "$tkabber_version ($toolkit_version)"]]

    if {$options(reply_iq_os_version)} {
	switch -glob -- $tcl_platform(os) {
	    Linux {
		set os "[guess_linux_distribution] $tcl_platform(osVersion)"
	    }
	    Win* {
		set os [join [guess_windows_version]]
	    }
	    default {
		set os "$tcl_platform(os) $tcl_platform(osVersion)"
	    }
	}
    
	lappend restags [jlib::wrapper:createtag os -chdata $os]
    }

    set res [jlib::wrapper:createtag query \
		 -vars {xmlns jabber:iq:version} \
		 -subtags $restags]
    
    return [list result $res]
}

iq::register_handler get query jabber:iq:version \
    [namespace current]::iq_version

proc disco_extra_version {connid from lang} {
    global tkabber_version toolkit_version tcl_platform
    variable options

    set fields \
	[list [jlib::wrapper:createtag field \
		   -vars [list var  FORM_TYPE \
			       type hidden] \
		   -subtags [list [jlib::wrapper:createtag value -chdata \
				       urn:xmpp:dataforms:softwareinfo]]] \
	      [jlib::wrapper:createtag field \
		   -vars [list var software] \
		   -subtags [list [jlib::wrapper:createtag value \
				       -chdata Tkabber]]] \
	      [jlib::wrapper:createtag field \
		   -vars [list var software_version] \
		   -subtags [list [jlib::wrapper:createtag value -chdata \
				   "$tkabber_version ($toolkit_version)"]]]]

    if {$options(reply_iq_os_version)} {
	switch -glob -- $tcl_platform(os) {
	    Linux {
		set os [guess_linux_distribution]
		set os_version $tcl_platform(osVersion)
	    }
	    Win* {
		lassign [guess_windows_version] os os_version
	    }
	    default {
		set os $tcl_platform(os)
		set os_version $tcl_platform(osVersion)
	    }
	}
    
	lappend fields \
		[jlib::wrapper:createtag field \
		     -vars [list var os] \
		     -subtags [list [jlib::wrapper:createtag value \
				         -chdata $os]]] \
		[jlib::wrapper:createtag field \
		     -vars [list var os_version] \
		     -subtags [list [jlib::wrapper:createtag value \
					 -chdata $os_version]]]
    }

    return [jlib::wrapper:createtag x \
		-vars [list xmlns $::NS(data) \
			    type  result] \
		-subtags $fields]
}

hook::add postload_hook \
	[list disco::register_extra [namespace current]::disco_extra_version]
