forked from hummypkg/webif
118 lines
3.1 KiB
Plaintext
118 lines
3.1 KiB
Plaintext
|
|
proc ladd {var args} {
|
|
upvar $var v
|
|
foreach val $args {
|
|
if {$val ni $v} { lappend v $val }
|
|
}
|
|
}
|
|
|
|
proc lremove {var val} {
|
|
upvar $var v
|
|
if {$val ni $v} return
|
|
set v [lsearch -all -inline -not -exact $v $val]
|
|
}
|
|
|
|
# Returns the epoch time for midnight today, accounting for local timezone
|
|
proc midnight {} {{today ""}} {
|
|
if {$today eq ""} {
|
|
set today [clock format [clock seconds] -format "%Y %m %d"]
|
|
}
|
|
return [clock scan "$today 00:00:00" -format "%Y %m %d %T"]
|
|
}
|
|
|
|
# Base-64 according to RFC 4648
|
|
# See https://wiki.tcl-lang.org/page/base64
|
|
|
|
if {![exists -command binary]} { package require binary }
|
|
|
|
# RFC 4648 section 4
|
|
set ::b64::map {
|
|
000000 A 000001 B 000010 C 000011 D 000100 E 000101 F
|
|
000110 G 000111 H 001000 I 001001 J 001010 K 001011 L
|
|
001100 M 001101 N 001110 O 001111 P 010000 Q 010001 R
|
|
010010 S 010011 T 010100 U 010101 V 010110 W 010111 X
|
|
011000 Y 011001 Z 011010 a 011011 b 011100 c 011101 d
|
|
011110 e 011111 f 100000 g 100001 h 100010 i 100011 j
|
|
100100 k 100101 l 100110 m 100111 n 101000 o 101001 p
|
|
101010 q 101011 r 101100 s 101101 t 101110 u 101111 v
|
|
110000 w 110001 x 110010 y 110011 z 110100 0 110101 1
|
|
110110 2 110111 3 111000 4 111001 5 111010 6 111011 7
|
|
111100 8 111101 9 111110 + 111111 /
|
|
}
|
|
|
|
set ::b64::unmap [join [lmap {a b} $::b64::map {list $b $a}]]
|
|
|
|
proc ::b64::encode {str} {
|
|
binary scan $str B* bits
|
|
switch [expr {[string length $bits]%6}] {
|
|
0 {set tail {}}
|
|
2 {append bits 0000; set tail ==}
|
|
4 {append bits 00; set tail =}
|
|
}
|
|
return [string cat [string map $::b64::map $bits] $tail]
|
|
}
|
|
|
|
proc ::b64::decode {str} {
|
|
set nstr [string trimright $str =]
|
|
set dstr [string map $::b64::unmap $nstr]
|
|
switch [expr [string length $str]-[string length $nstr]] {
|
|
0 {#nothing to do}
|
|
1 {set dstr [string range $dstr 0 {end-2}]}
|
|
2 {set dstr [string range $dstr 0 {end-4}]}
|
|
}
|
|
return [binary format B* $dstr]
|
|
}
|
|
|
|
# RFC 4648 section 5
|
|
proc ::b64::url_encode {str} {
|
|
tailcall string map {+ - / _ = ""} [::b64::encode $str]
|
|
}
|
|
|
|
proc ::b64::url_decode {str} {
|
|
tailcall ::b64::decode [string map {- + _ /} $str]
|
|
}
|
|
|
|
alias b64encode ::b64::encode
|
|
alias b64decode ::b64::decode
|
|
alias b64uencode ::b64::url_encode
|
|
alias b64udecode ::b64::url_decode
|
|
|
|
|
|
# ECMA-262 Annex B.2.1
|
|
proc ::js::_escape {str} {
|
|
return [join [lmap c [split $str ""] {
|
|
if {1 != [scan $c "%c" cc]} {
|
|
format "%s" $c
|
|
} elseif {$cc < 256} {
|
|
format "%%%02X" $cc
|
|
} else {
|
|
format "%%u%04X" $cc
|
|
}
|
|
}] ""]
|
|
}
|
|
|
|
proc ::js::_unescape {str} {
|
|
if {1 == [scan $str "%%%2x" cc] ||
|
|
1 == [scan $str "%%u%4x" cc]} {
|
|
return [format "%c" $cc]
|
|
} else {
|
|
return $str
|
|
}
|
|
}
|
|
|
|
proc ::js::escape {str} {
|
|
return [subst -nobackslashes -novariables \
|
|
[regsub -all -- {[^A-Za-z0-9@*_+./-]+} $str \
|
|
{[::js::_escape {&}]}]]
|
|
}
|
|
|
|
proc ::js::unescape {str} {
|
|
return [subst -nobackslashes -novariables \
|
|
[regsub -all -- {%(u[[:xdigit:]]{2})?[[:xdigit:]]{2}} $str \
|
|
{[::js::_unescape {&}]}]]
|
|
}
|
|
|
|
alias jsescape ::js::escape
|
|
alias jsunescape ::js::unescape
|
|
|