1984d7151b
git-svn-id: file:///root/webif/svn/humax/pkg/src/webif/trunk@1784 2a923420-c742-0410-a762-8d5b09965624
45 lines
766 B
Plaintext
45 lines
766 B
Plaintext
#!/mod/bin/jimsh
|
|
|
|
proc _lock_to_port {id} {
|
|
set len [string length $id]
|
|
set hash $len
|
|
|
|
for {set i 0} {$i < $len} {incr i} {
|
|
scan [string index $id $i] "%c" asc
|
|
set hash [expr (($hash<<5)^($hash>>27))^$asc];
|
|
}
|
|
|
|
return [expr (65535 - ($hash % 101))]
|
|
}
|
|
|
|
proc _lock_dummy {newsock addr port} { }
|
|
|
|
proc acquire_lock {id {timeout 0}} {
|
|
global _locks
|
|
|
|
set port [_lock_to_port $id]
|
|
|
|
incr timeout [clock seconds]
|
|
|
|
while {[catch {set socket [\
|
|
socket stream.server "127.0.0.1:$port"]} msg]} {
|
|
if {[clock seconds] > $timeout} { return 0 }
|
|
sleep 0.2
|
|
}
|
|
|
|
set _locks($id) $socket
|
|
return 1
|
|
}
|
|
|
|
proc release_lock {id} {
|
|
global _locks
|
|
|
|
if {[catch {close $_locks($id)} msg]} {
|
|
puts "Error releasing lock: $msg"
|
|
return 0
|
|
}
|
|
unset _locks($id)
|
|
return 1
|
|
}
|
|
|