tclhttpd

Check-in [6174565fef]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added the pageHeader and pageFooter methods to httpd.meta Community and its decendents now render pages in bootstrap/jquery.
Timelines: family | ancestors | descendants | both | private
Files: files | file ages | folders
SHA1:6174565fef1aeaba87245cc5245b2f95db501349
User & Date: hypnotoad 2015-04-03 07:30:36
Context
2015-04-03
07:35
Added more documentation Renamed the cookieSet method to httpdCookieSet, and moved it to httpd.meta Moved httpdHostName it to httpd.meta Implemented logins using encrypted password hashes Added a module to store javascript password hashing routines. Added a "cat" command to dump files Added the pageHeader and pageFooter methods to httpd.meta Community and its decendents now render pages in bootstrap/jquery. Added jquery to our bootstrap distribution check-in: 80751cdeac user: hypnotoad tags: 4_0
07:30
Added the pageHeader and pageFooter methods to httpd.meta Community and its decendents now render pages in bootstrap/jquery. Leaf check-in: 6174565fef user: hypnotoad tags: private
06:45
Implemented logins using encrypted password hashes Added a module to store javascript password hashing routines. Added a "cat" command to dump files check-in: 192b2e9d60 user: hypnotoad tags: private
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to bin/test/qwiki.tcl.

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
  superclass httpd.qwiki

  ###
  # title: Implement html content at a toplevel
  ###
  method /html {} {
    my variable result
    array set result {
      code 200
      type text/html
    }

    set body {
<HTML><BODY>
Hello World!
<p>
    }
    append body "Logged in as user: [dict getnull $result(session) username]<br>"
    if {[info exists result(sessionid)]} {
      append body "Logged with session: $result(sessionid)<br>"
    }
    append body {
Try the following links:
<ul>
    }
    set prefix [my cget virtual]
    foreach {url comment} {
      errorurl {Throw an internal error from Tcl}
      deadurl  {Page that generates a 505 error}
      suburl   {Valid Suburl}
      missing  {Non-existent url}
      login    {Log In}
      logout   {Log Out}
    } {
      append body "<li><a href=$prefix/$url>$url</a> - $comment</li>"
    }
    append body {
</ul>
</BODY></HTML>
}
    set result(body) $body
  }

  method /html/errorurl {} {
    error "Die Yuppie Scum!"
  }

  method /html/deadurl {} {
    my variable result
    array set result {
      code 501
      body {
<HTML><BODY>

I threw an error this way
</BODY></HTML>
}
      content-type text/html
    }

  }

  ###
  # title: Implement html content at a toplevel
  ###
  method /html/suburl {} {
    my variable result
    array set result {
      code 200
      body {
<HTML><BODY>
Sub Url
</BODY></HTML>
}
      type text/html
    }

  }

  ###
  # title: Implement html content at a toplevel
  ###
  method /html/default {} {
    my variable result
    array set result {
      code 404
      body {
<HTML><BODY>

Not Found
</BODY></HTML>
}
      type text/html
    }

  }
}

qwikitest create HOME /home [list dbfile [Config dbfile]]

vwait forever
if 0 {







|
|
<
|
>
|
<



|

|

|












|

|



<








|
|
|
<
>

<
|
<
<
>







|
|
|
|
<
<
|
<
<
>







|
|
|
<
>

<
|
<
<
>







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
  superclass httpd.qwiki

  ###
  # title: Implement html content at a toplevel
  ###
  method /html {} {
    my variable result
    my reset
    set result(title) {Welcome to Qwiki!}


    my puts [my pageHeader]
    my puts {

Hello World!
<p>
    }
    my puts "Logged in as user: [dict getnull $result(session) username]<br>"
    if {[info exists result(sessionid)]} {
      my puts "Logged with session: $result(sessionid)<br>"
    }
    my puts {
Try the following links:
<ul>
    }
    set prefix [my cget virtual]
    foreach {url comment} {
      errorurl {Throw an internal error from Tcl}
      deadurl  {Page that generates a 505 error}
      suburl   {Valid Suburl}
      missing  {Non-existent url}
      login    {Log In}
      logout   {Log Out}
    } {
      my puts "<li><a href=$prefix/$url>$url</a> - $comment</li>"
    }
    my puts {
</ul>
</BODY></HTML>
}

  }

  method /html/errorurl {} {
    error "Die Yuppie Scum!"
  }

  method /html/deadurl {} {
    my variable result
    my reset
    set result(code) 501
    my puts [my pageHeader]

    my puts {
I threw an error this way

    }


    my puts [my pageFooter]
  }

  ###
  # title: Implement html content at a toplevel
  ###
  method /html/suburl {} {
    my variable result
    my reset
    my puts [my pageHeader]
    my puts {
This is a suburl!


    }


    my puts [my pageFooter]
  }

  ###
  # title: Implement html content at a toplevel
  ###
  method /html/default {} {
    my variable result
    my reset
    set result(code) 404
    my puts [my pageHeader]

    my puts {
Not Found

    }


    my puts [my pageFooter]
  }
}

qwikitest create HOME /home [list dbfile [Config dbfile]]

vwait forever
if 0 {

Added modules/bootstrap/js/jquery.min.js.

cannot compute difference between binary files

Changes to modules/community/community.tcl.

8
9
10
11
12
13
14

15
16
17
18
19
20
21
...
367
368
369
370
371
372
373
374





375
376
377
378
379


380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406



407
408
409
410
411
412
413
414
415
...
419
420
421
422
423
424
425






426
427
428
429
430
431
432
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
...
477
478
479
480
481
482
483
484
485
486
487
488
489
package require sha1 2

package require httpd::taourl
package require httpd::cookie	;# Cookie_GetSock Cookie_Make
package require httpd::doc	;# Doc_Root
package require httpd::utils	;# Stderr file iscommand randomx
package require httpd::jshash   ;# Javascript password hashes


tao::class httpd.community {  
  superclass httpd.taourl taodb::yggdrasil
  
  option virtual {}
  option dbfile {}
  option community-id {}
................................................................................
      }
      my <db> eval "COMMIT"
    }
  }
  
  method pageHeader {} {
    return {
<HTML><BODY>





    }
  }
  
  method pageFooter {} {
    return {


</BODY></HTML>
    }
  }

  method /html/logout {} {
    my variable result
    
    my puts [my pageHeader]
    my puts "You have been logged out"
    set sesid $result(sessionid)
    my <db> eval {
update session set userid='local.anonymous' where sesid=:sesid;
delete from session_property where sesid=:sesid;
}
    dict set result(session) username anonymous
    dict set result(session) userid local.anonymous

    my puts [my pageFooter]
  }
  
  method /html/login {} {
    my variable result
    
    my reset
    my puts <html>
    my puts {
  <head>



    <TITLE>Log In</TITLE>
    <script type="text/javascript" src="/jshash/sha1.js"></script>
    <script type="text/javascript">  
function login() {
  
    var p = hex_sha1(document.getElementById('key').value+document.getElementById('pass').value);  
    var k = document.getElementById('sesid').value;  

    var h = hex_sha1(k+p);  
................................................................................
    f.submit();  
}  
    </script>
  </head>
    }    
    my puts {
  <body>






<table>
<form action="authenticate" method="post" id="finalform">
<tr><th>Username:</th><td><input name="uid" id="uid" /></td></tr>
<input type="hidden" name="hash" id="hash" />  
</form>
    }
    my puts {<form action="javascript:login()" method="post" >}
................................................................................
  </body>
    }
    my puts </html>
  }

  method /html/authenticate {} {
    my variable result
    my reset
    my puts [my pageHeader]

    my puts "sesid: $result(sessionid)<br>"    
    foreach {field value} $result(query) {
      if {$field eq "uid"} {
        set username $value
        my puts "Username: $value<br>"
        foreach {field value} $result(query) {
          if {$field eq "hash"} {
            my puts "Hash: $value<br>"
            set passhash [my <db> one {select password from users where username=:username}]
            set realhash [::sha1::sha1 -hex "$result(sessionid)$passhash"]
            my puts "Passhash: $passhash<br>"
            my puts "Realhash: $realhash<br>"
            if { $realhash eq $value } {
              set userid [my <db> one {select username from users where username=:username}]
              my <db> eval {update session set userid=:userid where sesid=:result(sessionid)}
              dict set result(session) username $username
              dict set result(session) userid $userid

              set root [my cget virtual]
................................................................................
              my puts </BODY></HTML>
              return
            }
          }
        }
      }
    }
    puts "Password or Username was incorrect or invalid."
    my puts [my pageFooter]
  }
}

package provide httpd::community 0.1







>







 







|
>
>
>
>
>





>
>






<
<
<







|
|









>
>
>

|







 







>
>
>
>
>
>







 







<
<
<
<



<


<


<
<







 







|
|




8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393



394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
...
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
...
455
456
457
458
459
460
461




462
463
464

465
466

467
468


469
470
471
472
473
474
475
...
483
484
485
486
487
488
489
490
491
492
493
494
495
package require sha1 2

package require httpd::taourl
package require httpd::cookie	;# Cookie_GetSock Cookie_Make
package require httpd::doc	;# Doc_Root
package require httpd::utils	;# Stderr file iscommand randomx
package require httpd::jshash   ;# Javascript password hashes
package require httpd::bootstrap

tao::class httpd.community {  
  superclass httpd.taourl taodb::yggdrasil
  
  option virtual {}
  option dbfile {}
  option community-id {}
................................................................................
      }
      my <db> eval "COMMIT"
    }
  }
  
  method pageHeader {} {
    return {
<HTML>
<HEAD>
    <TITLE>@TITLE@</TITLE>
    <link rel="stylesheet" href="/bootstrap/css/bootstrap.min.css">
</HEAD>
<BODY>
    }
  }
  
  method pageFooter {} {
    return {
<script type="text/javascript" src="/bootstrap/js/bootstrap.min.js"></script>
<script type="text/javascript" src="/bootstrap/js/jquery.min.js"></script>
</BODY></HTML>
    }
  }

  method /html/logout {} {
    my variable result



    set sesid $result(sessionid)
    my <db> eval {
update session set userid='local.anonymous' where sesid=:sesid;
delete from session_property where sesid=:sesid;
}
    dict set result(session) username anonymous
    dict set result(session) userid local.anonymous
    set result(message) {You have been logged out}
    my /html/login
  }
  
  method /html/login {} {
    my variable result
    
    my reset
    my puts <html>
    my puts {
  <head>
    <link rel="stylesheet" href="/bootstrap/css/bootstrap.min.css">
    <script type="text/javascript" src="/bootstrap/js/bootstrap.min.js"></script>
    <script type="text/javascript" src="/bootstrap/js/jquery.min.js"></script>
    <TITLE>Log In</TITLE>
    <script type="text/javascript" src="/jshash/sha1-min.js"></script>
    <script type="text/javascript">  
function login() {
  
    var p = hex_sha1(document.getElementById('key').value+document.getElementById('pass').value);  
    var k = document.getElementById('sesid').value;  

    var h = hex_sha1(k+p);  
................................................................................
    f.submit();  
}  
    </script>
  </head>
    }    
    my puts {
  <body>
    }
    set msg [get result(message)]
    if { $msg ne {} } {
      my puts "<pre><font color=”red” face=”sans-serif” size=”1”>$msg</font></pre><hr>"
    }
    my puts {
<table>
<form action="authenticate" method="post" id="finalform">
<tr><th>Username:</th><td><input name="uid" id="uid" /></td></tr>
<input type="hidden" name="hash" id="hash" />  
</form>
    }
    my puts {<form action="javascript:login()" method="post" >}
................................................................................
  </body>
    }
    my puts </html>
  }

  method /html/authenticate {} {
    my variable result




    foreach {field value} $result(query) {
      if {$field eq "uid"} {
        set username $value

        foreach {field value} $result(query) {
          if {$field eq "hash"} {

            set passhash [my <db> one {select password from users where username=:username}]
            set realhash [::sha1::sha1 -hex "$result(sessionid)$passhash"]


            if { $realhash eq $value } {
              set userid [my <db> one {select username from users where username=:username}]
              my <db> eval {update session set userid=:userid where sesid=:result(sessionid)}
              dict set result(session) username $username
              dict set result(session) userid $userid

              set root [my cget virtual]
................................................................................
              my puts </BODY></HTML>
              return
            }
          }
        }
      }
    }
    set result(message) {Password or Username was incorrect or invalid.}
    my /html/login
  }
}

package provide httpd::community 0.1

Changes to modules/directoo/directoo.tcl.

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
...
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
...
238
239
240
241
242
243
244
245
246
247
248

249




















250
251
252
253
254
255
  method httpdDirect {sock suffix} {
    global env
    upvar #0 Httpd$sock data
    my variable result
    set prefix [my cget virtual]
    my httpdSessionLoad $sock $prefix $suffix
    set cmd [my httpdMarshalArguments $sock $suffix]
    ::Stderr $cmd
    # Eval the command.  Errors can be used to trigger redirects.

    if [catch $cmd] {
      set result(code) 505
      set result(body) "<HTML><BODY>Error: <PRE><VERBATIM>$::errorInfo</VERBATIM></PRE></BODY></HTML>"
      set result(content-type) text/html 
    }
................................................................................
      }
      302 {
        # Redirect.
        ::Httpd_Redirect $result(redirect) $sock
        return
      }
      default {

        if {$result(date)} {
          ::Httpd_ReturnCacheableData $sock $result(content-type) $result(body) $result(date) $result(code)
        } else {
          ::Httpd_ReturnData $sock $result(content-type) $result(body) $result(code)
        }
        return
      }
    }
  }
  
  method httpdSessionLoad {sock prefix suffix} {
    my variable result
    array set result {
      code 200
      date  0
      header {}
      footer {}
      body {}
      redirect {}
      content-type text/html
    }
    set result(sock) $sock
    set result(datavar) ::Httpd$sock 

................................................................................
  }
  
  ###
  # title: Implement html content at a toplevel
  ###
  method /html {} {
    my variable result
    array set result {
      code 200
      body {
<HTML><BODY>

Hello World




















</BODY></HTML>
}
      content-type text/html
    }
  }
}







<







 







>

|

|











|
<







 







|
|
|
<
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
<
|
|

86
87
88
89
90
91
92

93
94
95
96
97
98
99
...
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
...
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
  method httpdDirect {sock suffix} {
    global env
    upvar #0 Httpd$sock data
    my variable result
    set prefix [my cget virtual]
    my httpdSessionLoad $sock $prefix $suffix
    set cmd [my httpdMarshalArguments $sock $suffix]

    # Eval the command.  Errors can be used to trigger redirects.

    if [catch $cmd] {
      set result(code) 505
      set result(body) "<HTML><BODY>Error: <PRE><VERBATIM>$::errorInfo</VERBATIM></PRE></BODY></HTML>"
      set result(content-type) text/html 
    }
................................................................................
      }
      302 {
        # Redirect.
        ::Httpd_Redirect $result(redirect) $sock
        return
      }
      default {
        set body [string map [list @TITLE@ $result(title)] $result(body)]
        if {$result(date)} {
          ::Httpd_ReturnCacheableData $sock $result(content-type) $body $result(date) $result(code)
        } else {
          ::Httpd_ReturnData $sock $result(content-type) $body $result(code)
        }
        return
      }
    }
  }
  
  method httpdSessionLoad {sock prefix suffix} {
    my variable result
    array set result {
      code 200
      date  0
      title {}

      body {}
      redirect {}
      content-type text/html
    }
    set result(sock) $sock
    set result(datavar) ::Httpd$sock 

................................................................................
  }
  
  ###
  # title: Implement html content at a toplevel
  ###
  method /html {} {
    my variable result
    set result(title) {Welcome!}
    my reset
    my puts [my pageHeader]

    my puts {
Hello World
    }
    my puts [my pageFooter]
  }
  

  method pageHeader {} {
    return {
<HTML>
<HEAD>
    <TITLE>@TITLE@</TITLE>
    <link rel="stylesheet" href="/bootstrap/css/bootstrap.min.css">
</HEAD>
<BODY>
    }
  }
  
  method pageFooter {} {
    return {
<script type="text/javascript" src="/bootstrap/js/bootstrap.min.js"></script>
<script type="text/javascript" src="/bootstrap/js/jquery.min.js"></script>
</BODY></HTML>
    }

  }

}