tcllib 1.19-dfsg-2 / usr / share / tcltk / tcllib1.19 / nettool / build.tcl

This file is indexed.

/usr/share/tcltk/tcllib1.19/nettool/build.tcl is in tcllib 1.19-dfsg-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
set here [file dirname [file normalize [file join [pwd] [info script]]]]

set version 0.5.2
set tclversion 8.5
set module [file tail $here]

dict set map %module% $module
dict set map %version% $version
dict set map %tclversion% $tclversion
dict set map {    } {}
dict set map "\t" {    }

###
# Rebuild the available ports file
###
###
# topic: 65dfea29d424543cdfc0e1cbf9f90295ef6214cb
# description:
#    This script digests the raw data from
#    http://www.iana.org/assignments/service-names-port-numbers/service-names-port-numbers.csv
#    And produces a summary
###
proc ::record {service port type usage} {
  if { $port eq {} } return
  if {$service eq {} && $type in {tcp udp {}} && $usage != "Reserved"} {
    ladd ::available_port($port) {*}$type
    return
  }
  unset -nocomplain ::available_port($port)
  lappend ::busy_port($port) $type $usage
  #puts [list busy $service $port $type $usage]
}

for {set x 0} {$x < 65536} {incr x} {
  set ::available_port($x) {}
}
package require dicttool
package require csv
set fin [open [file join $here src service-names-port-numbers.csv] r]
set headers [gets $fin]
set thisline {}
while {[gets $fin line]>=0} {
  append thisline \n$line
  if {![csv::iscomplete $line]} continue
  set lline [csv::split $line]
  if [catch {
  set service [lindex $lline 0]
  set port [lindex $lline 1]
  set type [lindex $lline 2]
  set usage [lindex $lline 3]

  }] continue
  if {![string is integer -strict $port]} {
    set startport [lindex [split $port -] 0]
    set endport [lindex [split $port -] 1]
    if {[string is integer -strict $startport] && [string is integer -strict $endport]} {
      for {set i $startport} {$i<=$endport}  {incr i}  {
        record $service $i $type $usage
      }
      continue
    }
  }
  record $service $port $type $usage
}
close $fin

set fout [open [file join $here available_ports.tcl] w]
puts $fout {
namespace eval ::nettool {
  set blocks {}
}
}
set startport 0
set endport 0

foreach port [lsort -integer [array names  available_port]] {
  set avail $available_port($port)
  # Don't bother with ports below 1024
  # Most operating systems won't let us access them anyway
  if {$port < 1024 } continue
  if { $endport == ($port-1) } {
    set endport $port
    continue
  }
  if {$startport} {
    puts $fout [list lappend ::nettool::blocks $startport $endport]
  }
  set startport $port
  set endport $port
}
if { $startport } {
  puts $fout [list lappend ::nettool::blocks $startport $endport]
}
close $fout

set fout [open [file join $here [file tail $module].tcl] w]
puts $fout [string map $map {###
    # Amalgamated package for %module%
    # Do not edit directly, tweak the source in src/ and rerun
    # build.tcl
    ###
    package require Tcl %tclversion%
    package provide %module% %version%
    namespace eval ::%module% {}
    set ::%module%::version %version%
}]

# Track what files we have included so far
set loaded {}
# These files must be loaded in a particular order
foreach file {
  core.tcl
  generic.tcl
  available_ports.tcl
  locateport.tcl
  platform_unix.tcl
  platform_unix_linux.tcl
  platform_unix_macosx.tcl
  platform_windows.tcl
  platform_windows_twapi.tcl
} {
  lappend loaded $file
  set fin [open [file join $here src $file] r]
  puts $fout "###\n# START: [file tail $file]\n###"
  puts $fout [read $fin]
  close $fin
  puts $fout "###\n# END: [file tail $file]\n###"
}

# These files can be loaded in any order
foreach file [glob [file join $here src *.tcl]] {
  if {[file tail $file] in $loaded} continue
  lappend loaded $file
  set fin [open [file join $here src $file] r]
  puts $fout "###\n# START: [file tail $file]\n###"
  puts $fout [read $fin]
  close $fin
  puts $fout "###\n# END: [file tail $file]\n###"
}

# Provide some cleanup and our final package provide
puts $fout [string map $map {
    namespace eval ::%module% {
	namespace export *
    }
    ###
    # Perform any one-time discovery we might need
    ###
    ::nettool::discover
    ::nettool::init
}]
close $fout

###
# Build our pkgIndex.tcl file
###
set fout [open [file join $here pkgIndex.tcl] w]
puts $fout [string map $map {
    if {![package vsatisfies [package provide Tcl] %tclversion%]} {return}
    # Backward compatible alias
    package ifneeded nettool::available_ports 0.1 {package require %module% ; package provide nettool::available_ports 0.1}
    package ifneeded %module% %version% [list source [file join $dir %module%.tcl]]
}]
close $fout

APT Browse - Built by Thomas Orozco.