aboutsummaryrefslogtreecommitdiff
path: root/src/server/httpd/httpd.tcl
blob: b579411456d44655f71f397d11b75dc87ebd914f (plain)
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
# some dummy proc's to get things going for test purposes



proc ip {} {
return 10.0.0.55
}

proc start_chunked {a} {
	global httpdata
	global httpmime
	set httpmime $a
	set httpdata ""
}

proc write_chunked {a} {
	global httpdata
	append httpdata $a
}

proc end_chunked {} {
}



#proc formfetch {a} {
#	global httppostdata
	#catch { 
#	echo "$a=$httppostdata($a)"
	#return $httppostdata($a) 
	#}
#	
	#return ""  
#}




proc tohex {a} {
   set r ""
   while 1 {

      set rem [expr $a%16]
      set a [expr $a/16]
      set r [string index "0123456789abcdef" $rem]$r
      if ($a==0) then break
   }  
   return $r 
}

# encode text
proc encode {a} {
	return [string map {\n <br/> { } {&nbsp;} \t {&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} > &gt; < &lt; / &#47;} $a]
}

#stubs that can be overriden to save between sessions
proc load_var {a} {
	global glob_var
	catch {
		return $glob_var($a)
	}
	return ""
}
#stubs that can be overriden to save between sessions
proc save_var {a b} {
	catch { 
	set glob_var($a) $b
	return ""
	} err
	set glob_var($a) ""
	return ""
}



proc to_textarea {a} {
	return [string map {& &#38; > &gt; < &lt; / &#47;} $a]
}	

proc from_textarea {a} {
	return [string map {&gt; > &lt; < &#38; & &#47; /} $a]
}
	
proc lunion {a b} {
	foreach e $a {
		set x($e) {}
	}
 	foreach e $b {
		if {![info exists x($e)]} {
    		lappend a $e
		}
	}
 	return $a
}
 

# encode text
proc encode {a} {
	return [string map {\n <br/> { } {&nbsp;} \t {&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} > &gt; < &lt; / &#47;} $a]
}

# catch any exceptions, capture output and return it 
proc capture_catch {a} {
	catch {
		return [eval {capture $a}]
	} result
	return $result
}