teaparty
Check-in [09fa0e9b42]
Login
HomeTimelineFilesTicketsWiki
Overview
Comment:Added "sun4v" and "sun4u" to list of sparc64 types Copied web CustomKit interface into teaparty
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 09fa0e9b42245b0fd8f712ee868ead05c1e01de6
User & Date: rkeene on 2011-11-23 13:06:21
Other Links: manifest | tags
Context
2011-12-04
02:17
Updated to deal with more platforms check-in: 21cf4390c8 user: rkeene tags: trunk
2011-11-23
13:06
Added "sun4v" and "sun4u" to list of sparc64 types Copied web CustomKit interface into teaparty check-in: 09fa0e9b42 user: rkeene tags: trunk
2011-09-11
23:59
Updated to CTk 8.0.2801 to fix issues with Tcl 8.6 check-in: c80dceaca0 user: rkeene tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified client/lib/teapotclient0.1/teapotclient.tcl from [7c9f4e855b] to [a38541090a].

︙
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

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








+
+
+
+
+
+













+








			}

			vfs::zip::Unmount $mntfd $file
		} else {
			exec unzip -d $dir -n -qq $file
		}
	}

	proc __isCompatibleCPU {teapot local} {
	}

	proc __isCompatibleOS {teapot local} {
	}

	set pkgcachedir [file join [__get_homedir] ".teapot-client" "cachedir"]

        # Conversions from Teapot-style names to local ones
	set osTeapotToLocal(tcl) [list *]
	set osTeapotToLocal(linux-*) [list linux]
	set osTeapotToLocal(win32) [list windows]
	set osTeapotToLocal(solaris*) [list solaris sunos]
	set osTeapotToLocal(freebsd) [list freebsd_*]
	set osTeapotToLocal(irix) [list irix_*]

	set cpuTeapotToLocal(ix86) [list x86 intel i?86 i86pc]
	set cpuTeapotToLocal(sparc) [list sun4*]
	set cpuTeapotToLocal(sparc64) [list sun4u sun4v]
	set cpuTeapotToLocal(universal) [list *]
	set cpuTeapotToLocal(powerpc) [list ppc]

	proc download_extensions {rootdir servers extensions os cpu {existingExts ""}} {
		foreach chkdefext [list Tcl Tk msgcat] {
			if {[lsearch -exact $existingExts $chkdefext] == -1} {
				lappend existingExts $chkdefext
︙

Added client/web/common.tcl version [09d7dce52a]. 

























































































































































































































































































































































































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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#! /usr/bin/env tclsh

# This file has no license.  It is in the public domain.
# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q]

package require md5
package require Tclx

namespace eval ::customkit {}
namespace eval ::customkit {
	set starkitdir "/home/rkeene/devel/starkit2exe"
	set tclkitsdir "$starkitdir/tclkits"
	set findkit "$starkitdir/support/find-tclkit"
	set sdx "$starkitdir/support/sdx-1nrl.kit"
	set pkgcachedir "/tmp/DELETEME_customkit_[string tolower [md5::md5 -hex [list [info script] [id user]]]].cache"

	# Generate a mapping of Tclkits to user viewable and referencable keys
	array set Mapping [list]
	catch {
		foreach file [glob -nocomplain -directory $tclkitsdir *] {
			set work [split [file tail $file] -]
			set file_tclver [lindex $work 1]
			set file_os [lindex $work 2]
			set file_cpu [lindex $work 3]

			set file_exts [list Itcl Mk4tcl]

			if {[lindex $work 0] != "tclkitnotk"} {
				lappend file_exts "Tk"
			}

			unset -nocomplain file_info
			array set file_info {}
			catch {
				file stat $file file_info
				unset file_info(atime)
			}

			set key [string tolower [md5::md5 -hex [list $file [array get file_info] [expr [clock seconds] / 86400]]]]

			set Mapping($key) [list $file $file_tclver $file_os $file_cpu $file_exts]
		}
	}

	# Descriptive mappings
	set OSDesc(macosx) "Mac OS X"
	set OSDesc(macos) "Mac OS Classic"
	set OSDesc(freebsd) "FreeBSD"
	set OSDesc(openbsd) "OpenBSD"
	set OSDesc(netbsd) "NetBSD"
	set OSDesc(hpux) "HP/UX"
	set OSDesc(irix) "IRIX"
	set OSDesc(aix) "AIX"

	set CPUDesc(ppc) "PowerPC"
	set CPUDesc(m68k) "Motorola 68K"
	set CPUDesc(x86_64) "AMD64"
	set CPUDesc(parisc) "PA-RISC"
	set CPUDesc(sun4m) "SPARC"
	set CPUDesc(sun4u) "UltraSPARC"
	set CPUDesc(armv9) "ARM v9"

	# Conversions from Teapot-style names to local ones
	set osTeapotToLocal(tcl) *
	set osTeapotToLocal(linux-*) linux
	set osTeapotToLocal(win32) windows
	set osTeapotToLocal(solaris*) solaris
	set osTeapotToLocal(freebsd) freebsd_*
	set osTeapotToLocal(irix) irix_*

	set cpuTeapotToLocal(ix86) x86
	set cpuTeapotToLocal(sparc) sun4*
	set cpuTeapotToLocal(universal) *
	set cpuTeapotToLocal(powerpc) ppc


proc get_descs_from_mapping {} {
	upvar ::customkit::Mapping Mapping

	set descs [list]
	foreach key [array names Mapping] {
		set tclver [lindex $Mapping($key) 1]
		set os [lindex $Mapping($key) 2]
		set cpu [lindex $Mapping($key) 3]
		set exts [lindex $Mapping($key) 4]

		set os [descOSLocalToEnglish $os]
		set cpu [descCPULocalToEnglish $cpu]

		set desc "Tcl v$tclver for $os on the $cpu architecture"

		if {[lsearch -exact $exts "Tk"] == -1} {
			append desc " (no Tk)"
		}

		lappend descs [list $desc $key]
	}

	return $descs
}

proc descOSLocalToEnglish {os} {
	upvar ::customkit::OSDesc OSDesc

	set work [split $os _]
	set os_extra [join [lrange $work 1 end]]
	set os [lindex $work 0]
	if {[info exists OSDesc($os)]} {
		set os "$OSDesc($os) $os_extra"
	} else {
		set os "[string totitle $os] $os_extra"
	}
	set os [string trim $os]

	return $os
}

proc descCPULocalToEnglish {cpu} {
	upvar ::customkit::CPUDesc CPUDesc

	set new_cpu [list]
	foreach cpu [split $cpu +] {
		if {[info exists CPUDesc($cpu)]} {
			set cpu $CPUDesc($cpu)
		}
		lappend new_cpu $cpu
	}
	set cpu [join $new_cpu {, }]
}

proc download_extensions_teapot {rootdir servers extensions os cpu {existingExts "Tcl Tk"}} {
	package require http
	package require fileutil

	foreach server $servers {
		foreach {pkg pkginfo} [get_extensions_teapot $server $os $cpu] {
			foreach pkginstance $pkginfo {
				lappend pkginstance $server
				lappend pkgdata($pkg) $pkginstance
			}
		}
	}

	foreach pkg [array names pkgdata] {
		set pkgdata($pkg) [lsort -decreasing -dictionary $pkgdata($pkg)]
	}

	array set extDependencies [list]
	foreach extension $extensions {
		set extension [file tail $extension]

		if {![info exists pkgdata($extension)]} {
			continue
		}

		set pkginfo [lindex $pkgdata($extension) 0]

		set ver [lindex $pkginfo 0]
		set arch [lindex $pkginfo 1]
		set server [lindex $pkginfo 2]

		set pkgdir [file join $rootdir lib $extension$ver]
		file mkdir $pkgdir $::customkit::pkgcachedir

		set url "http://$server/package/name/$extension/ver/$ver/arch/$arch/file"
		set urlcachefile [file join $::customkit::pkgcachedir [::md5::md5 -hex $url]]

		if {![file exists $urlcachefile]} {
			set tmpfd [open $urlcachefile w]
			set token [::http::geturl $url -channel $tmpfd]

			::http::cleanup $token
			close $tmpfd
		}

		set retarr($extension) [list $ver $arch $server]
		switch -regexp -- [::fileutil::fileType $urlcachefile] {
			"(^| )zip($| )" {
				catch {
					exec unzip -d $pkgdir -n -qq $urlcachefile
				}

				# Process $pkgdir/teapot.txt
				set teapot [file join $pkgdir teapot.txt]
				if {[file exists $teapot]} {
					set fd [open $teapot r]
					for {gets $fd line} {![eof $fd]} {gets $fd line} {
						if {[string match "Meta require *" $line]} {
							set depinfo [lindex $line 2]
							set dep [lindex $depinfo 0]
							set depextra [lrange $depinfo 1 end]
							lappend extDependencies($dep) $depextra
						}
					}
					close $fd
				}
			}
			"(^| )text($| )" {
				unset -nocomplain fd

				set extfile [file join $pkgdir ${extension}.tcl]
				set idxfile [file join $pkgdir pkgIndex.tcl]

				catch {
					file copy -force -- $urlcachefile $extfile

					set fd [open $idxfile w]
					puts $fd "package ifneeded $extension $ver \[list source \[file join \$dir [file tail $extfile]\]\]"
				}

				catch {
					close $fd
				}

				# Process $extfile
				set fd [open $extfile r]
				for {gets $fd line} {![eof $fd]} {gets $fd line} {
					if {[string match "# Meta require *" $line]} {
						set depinfo [lindex $line 3]
						set dep [lindex $depinfo 0]
						set depextra [lrange $depinfo 1 end]
						lappend extDependencies($dep) $depextra
					}
				}
				close $fd
			}
		}
	}

	foreach {dep depinfo} [array get extDependencies] {
		set depReq -1
		foreach depinstinfo $depinfo {
			set depver [lindex $depinstinfo 0]
			set depinstinfo [lrange $depinstinfo 1 end]

			foreach {var val} $depinstinfo {
				switch -- $var {
					"-platform" {
						if {$val != $os} {
							if {$depReq == -1} {
								set depReq 0
							}
						}
					}
				}
			}
		}

		if {$depReq == 0} {
			continue
		}

		if {[lsearch $existingExts $dep] == -1} {
			lappend existingExts $dep
			lappend fetchDeps $dep
		}
	}

	if {[info exists fetchDeps]} {
		set addRet [download_extensions_teapot $rootdir $servers $fetchDeps $os $cpu $existingExts]
		array set retarr $addRet
	}

	return [array get retarr]
}

proc get_extensions_teapot {server {limitos "*"} {limitcpu "*"}} {
	upvar ::customkit::osTeapotToLocal osTeapotToLocal
	upvar ::customkit::cpuTeapotToLocal cpuTeapotToLocal

	set cachefile "/tmp/DELETEME_teapot_cache_[string tolower [md5::md5 -hex [list [info script] $server [id user]]]].tmp"
	set currtime [clock seconds]

	if {[file exists $cachefile]} {
		catch {
			set fd [open $cachefile r]
			set data [read $fd]
			close $fd

			set datatime [lindex $data 0]
			if {($currtime - $datatime) < 86400} {
				set children [lindex $data 1]
			}
		}
	}

	if {![info exists children]} {
		package require http

		set url "http://[join [list $server package list] /]"

		set token [::http::geturl $url]
		if {[::http::ncode $token] != "200"} {
			return [list]
		}

		set data [::http::data $token]
		::http::cleanup $token

		set work [join [split $data \n] { }]
		regexp {\[\[TPM\[\[(.*)\]\]MPT\]\]} $work -> children

		catch {
			set fd [open $cachefile w]
			puts $fd [list $currtime $children]
			close $fd
		}
	}

	foreach child $children {
		set type [lindex $child 0]
		if {$type != "package"} {
			continue
		}

		set pkg [lindex $child 1]
		set ver [lindex $child 2]
		set arch [lindex $child 3]
		set arch_work [split $arch -]
		set arch_os [join [lrange $arch_work 0 end-1] -]
		set arch_cpu [lindex $arch_work end]

		if {$arch == "source"} {
			continue
		}

		set isCompatOS 0
		if {$arch == "tcl"} {
			set isCompatOS 1
		} elseif {[string match $limitos $arch_os]} {
			set isCompatOS 1
		} else {
			foreach {teapot local} [array get osTeapotToLocal] {
				if {[string match $limitos $local] || [string match $local $limitos]} {
					if {[string match $teapot $arch_os] || [string match $arch_os $teapot]} {
						set isCompatOS 1
						break
					}
				}
			}
		}
		if {!$isCompatOS} {
			continue
		}

		set isCompatCPU 0
		if {$arch == "tcl"} {
			set isCompatCPU 1
		} elseif {[string match $limitcpu $arch_cpu]} {
			set isCompatCPU 1
		} else {
			foreach {teapot local} [array get cpuTeapotToLocal] {
				if {[string match $limitcpu $local] || [string match $local $limitcpu]} {
					if {[string match $teapot $arch_cpu] || [string match $arch_cpu $teapot]} {
						set isCompatCPU 1
						break
					}
				}
			}
		}
		if {!$isCompatCPU} {
			continue
		}

		lappend pkginfo($pkg) [list $ver $arch]
	}

	foreach pkg [array names pkginfo] {
		set pkginfo($pkg) [lsort -decreasing -dictionary $pkginfo($pkg)]
	}

	return [array get pkginfo]
}

}








Added client/web/customkit.rvt version [9192efd9c0].















































































































































































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
165
166
167
168
169
170
171

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

<?

# This file has no license.  It is in the public domain.
# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q]

if {[var exists source]} {
	headers type "text/plain; charset=us-ascii"
	rivet_flush

	set fd [open $::env(PATH_TRANSLATED) r]
	fcopy $fd stdout
	close $fd

	abort_page
	exit 0
}

source [file join [file dirname [info script]] common.tcl]

if {[var exists starpack_platform] && [var exists extensions]} {

	set ourkit [exec $::customkit::findkit]

	set starpack_platform [var get starpack_platform]
	set extensions [var get extensions]

	set platforminfo $::customkit::Mapping($starpack_platform)
	set platforminfo_kit [lindex $platforminfo 0]
	set platforminfo_tclver [lindex $platforminfo 1]
	set platforminfo_os [lindex $platforminfo 2]
	set platforminfo_cpu [lindex $platforminfo 3]

	set workdir [file join "/tmp" DELETEME_[::md5::md5 -hex [clock seconds][clock clicks][pid][array get ::env]]]
	set extpath [file join $workdir exts]
	set kitpath [file join $workdir kit]
	file mkdir $workdir

	array set incextensions [::customkit::download_extensions_teapot $extpath [list teapot.rkeene.org] $extensions $platforminfo_os $platforminfo_cpu]

	set webkit [file join kits customkit-v$platforminfo_tclver-$platforminfo_os-$platforminfo_cpu-[string tolower [::md5::md5 -hex [list $platforminfo [array get incextensions]]]].bin]

	if {![file exists $webkit]} {
		file copy -force -- $platforminfo_kit $kitpath

		catch {
			exec $ourkit $::customkit::sdx sync -auto 1 -forcedest 1 $extpath $kitpath
		}

		file mkdir [file dirname $webkit]
		file copy -force -- $kitpath $webkit
	}

	file delete -force -- $workdir
}

# Set content-type
headers type "text/html; charset=us-ascii"

rivet_flush

?><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
  <head>
    <title>CustomKit Builder</title>
  </head>
  <body>
    <h1>CustomKit</h1>
<?
if {[info exists webkit]} {
?>    <h2>Complete</h2>
    <div>
      The following CustomKit has been created: <a href="<? puts -nonewline $webkit ?>"><? puts -nonewline [file tail $webkit] ?></a>.  It was created with the following parameters:
      <table border="1">
        <tr>
          <td>Tcl Version:</td>
          <td><? puts -nonewline $platforminfo_tclver ?></td>
        </tr>
        <tr>
          <td>OS:</td>
          <td><? puts -nonewline [::customkit::descOSLocalToEnglish $platforminfo_os] ?></td>
        </tr>
        <tr>
          <td>CPU:</td>
          <td><? puts -nonewline [::customkit::descCPULocalToEnglish $platforminfo_cpu] ?></td>
        </tr>
        <tr>
          <td>Included Extensions:</td>
          <td>
<?
	foreach {ext extinfo} [array get incextensions] {
		set extinfo_ver [lindex $extinfo 0]
		if {[lsearch $extensions $ext] == -1} {
			puts "            <i>$ext v$extinfo_ver</i><br>"
		} else {
			puts "            $ext v$extinfo_ver<br>"
		}
	}
?>          </td>
        </tr>
        <tr>
          <td>Excluded Extensions:</td>
          <td>
<?
	foreach ext $extensions {
		if {![info exists incextensions($ext)]} {
			puts "            <b>$ext</b><br>"
		}
	}
?>          </td>
        </tr>
      </table>
    </div>
    <div>
      <a href="?start_over=1">Start Over</a>
    </div>
<?
} else {
?>    <h2>Select Parameters</h2>
    <form method="post" action="<? puts -nonewline $::env(REQUEST_URI) ?>">
      <table>
        <tr>
          <td>Target Platform:</td>
          <td>
            <select name="starpack_platform">
<?
	set descs [::customkit::get_descs_from_mapping]

	foreach desckey [lsort -dictionary $descs] {
		set desc [lindex $desckey 0]
		set key [lindex $desckey 1]
		puts "              <option value=\"$key\">$desc</option>"
	}
?>            </select>
          </td>
        </tr>
        <tr>
          <td>Extensions:</td>
          <td>
            <select name="extensions" size="20" multiple>
<?
	set extensionsinfo [::customkit::get_extensions_teapot teapot.rkeene.org]

	set extensions [list]
	foreach {extension extdata} $extensionsinfo {
		if {[lsearch -exact $extensions $extension] != -1} {
			continue
		}

		lappend extensions $extension
	}

	foreach extension [lsort -dictionary $extensions] {
		puts "              <option value=\"$extension\">$extension</option>"
	}
?>            </select>
          </td>
        </tr>
        <tr>
          <td colspan="2">
            <input type="submit" name="submit_upload" value="Create">
          </td>
        </tr>
      </table>
    </form>
<?
}
?>    <div>
      <a href="?source=1">Source</a>
    </div>
  </body>
</html>








Added client/web/tcl-to-exe.rvt version [aecea58e24].


























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

<?

# This file has no license.  It is in the public domain.
# -- Roy Keene <tcl@rkeene.org> [20081025T1400Q]

if {[var exists source]} {
        headers type "text/plain; charset=us-ascii"
        rivet_flush

        set fd [open $::env(PATH_TRANSLATED) r]
        fcopy $fd stdout
        close $fd

        abort_page
        exit 0
}

source [file join [file dirname [info script]] common.tcl]

if {[var exists starkit] && [var exists starpack_platform]} {
	headers type "text/plain"

	puts "[var get starkit]"
	puts "--"
	puts "[var get starpack_platform]"
	puts "--"
	puts "OK"
} else {
	# Set content-type
	headers type "text/html; charset=us-ascii"

?><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
  <head>
    <title>Starpacker <? puts -nonewline "[var exists starkit][var get starpack_platform {-}]" ?></title>
  </head>
  <body>
<?
	if {$::env(REQUEST_METHOD) == "POST"} {
		foreach {var val} [array get ::env] {
			puts "$var = \"$val\"<br>"
		}
	}
?>
    <form action="<? puts -nonewline $::env(REQUEST_URI) ?>" method="post" enctype="multipart/form-data">
      <table>
        <tr>
          <td>Upload file:</td>
          <td><input type="file" name="starkit"> (ZIP file, Tarball, Starkit, or Single Tcl File)</td>
        </tr>
        <tr>
          <td>Target Platform:</td>
          <td>
            <select name="starpack_platform">
<?
	set descs [::customkit::get_descs_from_mapping]

	foreach desckey [lsort -dictionary $descs] {
		set desc [lindex $desckey 0]
		set key [lindex $desckey 1]
		puts "              <option value=\"$key\">$desc</option>"
	}
?>            </select>
          </td>
        </tr>
        <tr>
          <td colspan="2">
            <input type="submit" name="submit_upload" value="Create">
          </td>
        </tr>
        <tr>
          <td colspan="2">
<?
	puts "$::env(REQUEST_METHOD)"
?>
          </td>
        </tr>
      </table>
    </form>
    <div>
      <a href="?source=1">Source</a>
    </div>
  </body>
</html><?
}
?>

















Powered by Fossil · RSS