register/site.tcl

77 lines
1.7 KiB
Tcl

source vendor/md5.tcl
source env.tcl
source wing.tcl
package require md5
package require wapp
sqlite3 db "./register.db"
proc wapp-default {} {
set B [wapp-param BASE_URL]
wingcss
wapp-trim {
<section class="container">
<h1>Hello, World!</h1>
<p>See the <a href='%html($B)/env'>Wapp
Environment</a></p>
</section>
}
}
proc wapp-page-submit {} {
wapp-allow-xorigin-params
set systemTime [clock seconds]
set iphash [md5::md5 [wapp-param REMOTE_ADDR]]
set method [wapp-param REQUEST_METHOD]
set arch [wapp-param arch]
set body [wapp-param CONTENT "<INVALID>"]
wapp-set-param TODAY $systemTime
wapp-set-param IPHASH $iphash
if {[string match {POST} $method] == 0} {
# bad method
wapp-reply-code 405
wapp-trim {
<h1>error</h1>
<p>use POST</p>
}
return
}
if {[string match {<INVALID>} $body] == 1} {
# bad request
wapp-reply-code 400
wapp-trim {
<h1>error</h1>
<p>send content please</p>
}
return
}
db eval {BEGIN}
db eval {INSERT INTO hits(ip_address_hash, arch, date) VALUES ($iphash, $arch, date($systemTime, 'unixepoch'))}
set pkgs [split $body "\n"]
foreach pkg $pkgs {
if {[string length $pkg] != 0} {
db eval {INSERT INTO package_installs(package_name, arch, date) VALUES ($pkg, $arch, date($systemTime, 'unixepoch'))}
}
}
db eval {COMMIT}
wapp-reply-code 200
wapp-trim {
<h1>thank you</h1>
<p>we promise to do our best to keep this data safe. thank you for your donation.</p>
}
}
wapp-start $::argv