#! /usr/bin/env wish

# ------------------------------------------------------------------------------
#  Command ::tk_listScreens
# ------------------------------------------------------------------------------
# Attempt to discover all the screens available to Tk.  Return them as a list.
#
# Brute-force search for available screens on the localhost, with screen
# identifiers :D.S where D and S are non-negative integers.  Tk quickly
# detects if there is no display, so the search is fast.
#
# On X11, in addition to displays from 0 to $maxDisplays-1, test for displays
# whose presence is suggested by the existence of a UNIX, TCP, or TCP6 socket.
#
# If the screen [winfo screen .] includes a hostname, and this is not equivalent
# to localhost, also do a brute-force search on that hostname, but for a smaller
# range of display and screen numbers, and again include display numbers
# suggested by X11 sockets.
#
# The screen [winfo screen .] is always included.
#
# If [winfo screen .] includes the hostname localhost, localhost4, localhost6,
# 127.0.0.1, or ::1, that hostname is retained in the list elements for that
# screen and for other screens on the same display, but is elided for other
# displays from the same host.  Tk is already using that display name, and we do
# not want two identifiers for the same screen.
#
# Notes
#
# [Bug 2912473] refers to unusual VNC screen names such as "::1:1.0"
# 1. How can these be discovered?
# 2. What is a legal screen name?  X(7) states:
#       hostname:displaynumber.screennumber
# - On localhost, hostname is empty.
# - On hosts reached by TCP/IP, hostname can be an IP address, or a full or
#   partial domain name.
# - On DECnet, hostname is nodename followed by ":" (in addition to the ":"
#   that always follows hostname), e.g. "hydra::0.1"
# - the VNC example has hostname ::1, the IPv6 localhost.
#
# winfo(n) lies that host is {}, i.e. that screen is ":D.S" but in fact
# it can be "H:D.S".
#
# Arguments:
# maxLocalDisplays - (optional) number of displays to try on localhost
# maxLocalScreens  - (optional) number of screens to try for each display
# maxHostDisplays  - (optional) number of displays to try on other host
# maxHostScreens   - (optional) number of screens to try for each display
#
# Return Value: a Tcl list of screens on which a Tk toplevel can be created.
# ------------------------------------------------------------------------------

proc ::tk_listScreens {
    {maxLocalDisplays 30} {maxLocalScreens 20}
    {maxHostDisplays 3} {maxHostScreens 2}
} {
    set onX11 [expr {[tk windowingsystem] eq "x11"}]
    set usingSDL [expr {[info exists ::tk::sdltk] && $::tk::sdltk}]

    set wtop [::tk::UnusedWindowPath .__temporary__toplevel_name_]


    if {(!$onX11) || $usingSDL} {
        set SocketNumbers {}
    } else {
        # On X11, find any numbers that appear to match a TCP/TCP6/UNIX socket.
        set SocketNumbers [::tk::DisplaysFromSockets]
    }

    # Process the hostname, display, and screen of [winfo screen .].
    # If not X11, hostname is {}, fullDisplay is :D.S, useHost is 0, stripMe is 1
    lassign [::tk::ExamineRootScreen] fullDisplay rootHost rootDisplay useHost stripMe

    ### Local Displays (hostname == {}, 127.0.0.1, etc) ###

    # Create a list of trial display numbers: brute-force plus detected sockets.
    set LocalNumbers [::tk::NumList $maxLocalDisplays]
    set LocalNumbers [lsort -integer -unique [concat $LocalNumbers $SocketNumbers]]

    set LocalDisplays {}
    foreach display $LocalNumbers {
        lappend LocalDisplays :${display}
    }

    if {$stripMe} {
        # OK if pos is -1.
        # Remove rootDisplay from LocalDisplays, add fullDisplay.
        # Avoid two descriptions of the same screen when fullDisplay
        # is prepended to LocalDisplays.
        set pos [lsearch -exact $LocalDisplays $rootDisplay]
        set LocalDisplays [lreplace $LocalDisplays $pos $pos]
        set LocalDisplays [linsert $LocalDisplays 0 $fullDisplay]
    }

    ### Host Displays (hostname neither empty nor localhost etc) ###
    ### Used on X11 only.

    set HostDisplays {}
    if {$useHost} {
        set HostNumbers [::tk::NumList $maxHostDisplays]
        set HostNumbers [lsort -integer -unique [concat $HostNumbers $SocketNumbers]]
        foreach display $HostNumbers {
            lappend HostDisplays ${rootHost}:${display}
        }
        set pos [lsearch -exact $HostDisplays $fullDisplay]
        set HostDisplays [lreplace $HostDisplays $pos $pos]
        set HostDisplays [linsert $HostDisplays 0 $fullDisplay]
    }
    # We now have two lists of candidate displays.
    # $fullDisplay is the display of window "." and has been included in one
    # of the lists, without duplication.

    set screenList {}
    foreach {Candidates maxScreens} [list $LocalDisplays $maxLocalScreens \
                                          $HostDisplays  $maxHostScreens  \
    ] {
        foreach display $Candidates {
            for {set screen 0} {$screen < $maxScreens} {incr screen} {
                set id ${display}.${screen}
                if {![catch {
                    toplevel $wtop -screen $id
                    destroy $wtop
                }]} {
                    lappend screenList $id
                }
            }
        }
    }

    # Move the screen of "." to the start of the list, add it if absent
    # (e.g. if it has a high screen number).
    set baseScreen [winfo screen .]
    set pos [lsearch -exact $screenList $baseScreen]
    set screenList [lreplace $screenList $pos $pos]
    set screenList [linsert $screenList 0 $baseScreen]

    return $screenList
}


# ------------------------------------------------------------------------------
#  Command ::tk::ExamineRootScreen
# ------------------------------------------------------------------------------
# Command to analyse [winfo screen .] and return a list of values that are
# helpful when searching for other screens.
#
# Hostnames 127.0.0.1, ::1, localhost, localhost4, localhost6, are identical to
# host {}.
# A screen name is hostname:D.S where D and S are non-negative integers.
# The full display name is hostname:D
# The display is :D
#
# When rootHost is not {} and is not localhost or equivalent -
# Should the script search host == rootHost, or host == {}, or both?
# - If $rootHost is an alias of localhost, and is not detected as such, its
#   display will be recorded twice.
# - If $rootHost is the name of this host, then on X11 listening
#   sockets will have been detected by ::tk::DisplaysFromSockets.
#   But we may need to use host $rootHost to connect.
# - If $rootHost is the name of a different host, the script's
#   attempts to create a toplevel amount to a portscan.  Also the
#   displays without a hostname may not be useful, and the attempts
#   to create a toplevel on these displays will likely fail for lack
#   of permission.
# - In either case the connection attempts on the non-{} host will be slow.
#   A smaller search will be used.
#
# Arguments:    none
#
# Return Value: a Tcl list of values derived from the root window:
#    fullDisplay - the name hostname:D of the display used by the window
#    rootHost    - the hostname 
#    rootDisplay - the display :D
#    useHost     - (boolean) use the host name, i.e. it is not equivalent to {}
#    stripMe     - (boolean) remove :D from the list before adding hostname:D
# ------------------------------------------------------------------------------

proc ::tk::ExamineRootScreen {} {
    # The regsub strips .screen if it is present (it should be).
    set fullDisplay [regsub {\.[0-9]+$} [winfo screen .] {}]

    if {[regexp {^(.*)(:[0-9]+)$} $fullDisplay DUM rootHost rootDisplay]} {
        if {$rootHost in {{} 127.0.0.1 ::1 localhost localhost4 localhost6}} {
            set useHost 0
            set stripMe 1
        } elseif {
            (![catch {exec ping  -c 1 $rootHost | grep -q {(127\.0\.0\.1)\|(::1)}}])
         || (![catch {exec ping6 -c 1 $rootHost | grep -q {(127\.0\.0\.1)\|(::1)}}])
        } {
            # $rootHost resolves to the local host.
            set useHost 0
            set stripMe 1
        } else {
            # rootHost is not {} and is not localhost or equivalent.
            set useHost 1
            set stripMe 0
        }
    } else {
        # Unexpected form for $fullDisplay
        set useHost 0
        set stripMe 0
        set rootHost {}
        set rootDisplay {}
    }
    return [list $fullDisplay $rootHost $rootDisplay $useHost $stripMe]
}


# ------------------------------------------------------------------------------
#  Command ::tk::UnusedWindowPath
# ------------------------------------------------------------------------------
# Return a Tk window path that is not already in use.
#
# Argument:
# prefix   - a valid Tk window path whose parent exists
#
# Returns the prefix argument with an integer suffix.
# ------------------------------------------------------------------------------

proc ::tk::UnusedWindowPath {prefix} {
    set parent [join [lrange [split $prefix .] 0 end-1] .]
    if {$parent eq {}} {
        set parent .
    }
    if {[string index $prefix 0] ne {.}} {
        return -code error "bad window prefix \"$prefix\""
    }
    if {(![winfo exists $parent])} {
        return -code error "parent window \"$parent\" does not exist"
    }
    for {set num 0} {1} {incr num} {
        set tryWin ${prefix}${num}
        if {![winfo exists $tryWin]} {
            break
        }
    }
    return $tryWin
}


# ------------------------------------------------------------------------------
#  Command ::tk::NumList
# ------------------------------------------------------------------------------
# Return a list of $num integers, from 0 to ($num - 1).
# ------------------------------------------------------------------------------

proc ::tk::NumList {num} {
    set ls {}
    for {set i 0} {$i < $num} {incr i} {
        lappend ls $i
    }
    return $ls
}

# For X11

# ------------------------------------------------------------------------------
# ::tk::DisplaysFromSockets
# ------------------------------------------------------------------------------
#
# Argument
# from    - ignore display numbers smaller than this
#
# Return a list of display numbers guessed from names of UNIX domain sockets and
# port numbers of TCP/TCP6 servers.  Ignore values less than argument "from".

# X11 sockets directory: standard location is /tmp/.X11-unix/, other locations
# listed are for HP/UX, some Solaris - states
# https://stackoverflow.com/questions/11367354/obtaining-list-of-all-xorg-displays
# ------------------------------------------------------------------------------

proc ::tk::DisplaysFromSockets {{from 0}} {
    set x11Sockets {
        /tmp/.X11-unix/X*
        /usr/spool/sockets/X11/X*
        /var/tsol/doors/.X11-unix/X*
    }

    if {[catch {glob {*}$x11Sockets} fileList]} {
        return
    }

    set displayList {}
    foreach disp $fileList {
        set dname [string range [file tail $disp] 1 end]
        if {    [file writable $disp]
             && ([file type $disp] eq {socket})
             && [string is integer -strict $dname]
             && ($dname >= $from)
        } {
            lappend displayList $dname
        }
    }

    if {![catch {exec netstat -ntl | grep {^tcp} \
                  | grep -o {:6[0-9][0-9][0-9] } | sed -e {s/^:6//; s/ //}} res]
    } {
        # Simple if netstat is installed.
        foreach line [split $res \n] {
            set num [expr {$line}]
            if {$num >= $from} {
                lappend displayList $num
            }
        }
    } else {
        lappend displayList {*}[ListeningTcpPorts tcp  6000 6999 $from]
        lappend displayList {*}[ListeningTcpPorts tcp6 6000 6999 $from]
    }
    set displayList [lsort -integer -unique $displayList]
    return $displayList
}

# ------------------------------------------------------------------------------
# ::tk::ListeningTcpPorts
# ------------------------------------------------------------------------------
# Command to return a list of listening TCP or TCP6 port numbers, each one
# reduced by a constant number.
# The command is useful if the system has /proc/net/tcp{,6} but not netstat.
#
# Arguments
# proto   - protocol - tcp or tcp6
# from    - minimum port number to examine; also subtracted from each result
# to      - maximum port number to examine
# min     - ignore results that are smaller than this
#
# Return Value: a Tcl list of integers, each one a candidate display number.
# ------------------------------------------------------------------------------

proc ::tk::ListeningTcpPorts {proto from to min} {
    if {$proto ni {tcp tcp6}} {
        return -code error {argument proto must be "tcp" or "tcp6"}
    }
    set displays {}
    set pattern {(?i)^[[:xdigit:]]+:([[:xdigit:]]+) [[:xdigit:]]+:0000 0A$}

    if {[catch {open /proc/net/$proto} fin]} {
        return
    }

    set code [catch {
        while {[gets $fin line] >= 0} {
            if {[string is list -strict $line]} {
                set lline [lrange $line 1 3]
                if {[regexp $pattern $lline DUM hex]} {
                    scan $hex %x foo
                    if {$foo >= $from + $min && $foo <= $to} {
                        incr foo -$from
                        lappend displays $foo
                    }
                }
            }
        }
    } res info]

    close $fin
    if {$code == 1} {
        return -code error -info $info $res
    }
    return $displays
}


puts [tk_listScreens]

exit

