improve locking

git-svn-id: file:///root/webif/svn/pkg/webif/trunk@2844 2a923420-c742-0410-a762-8d5b09965624

CONTROL/control

@@ -1,10 +1,10 @@
 Package: webif
 Priority: optional
 Section: web
-Version: 1.2.8-14
+Version: 1.2.8-15
 Architecture: mipsel
-Maintainer: af123@hummypkg.org.uk
+Maintainer: af123@hpkg.tv
-Depends: tcpfix,webif-channelicons(>=1.1.20),lighttpd(>=1.4.39-1),jim(>=0.76),jim-oo,jim-sqlite3(>=0.76),jim-cgi(>=0.7-1),jim-binary(>=0.76),service-control(>=2.1),busybox(>=1.20.2-1),lsof(>=4.87),epg(>=1.2.1),hmt(>=2.0.9),ssmtp,cron-daemon(>=1.18.3-3),at(>=3.1.18),anacron,trm(>=1.1),openssl-command,nicesplice,id3v2,file,rsvsync(>=1.0.2),webif-charts(>=1.2-1),stripts(>=1.2.5-3),tmenu(>=1.08),ffmpeg,id3v2,multienv(>=1.6),tcpping(>=1.1),e2fsprogs,wireless-tools(>=29-1),dbupdate,recmon(>=2.0.7)
+Depends: tcpfix,webif-channelicons(>=1.1.20),lighttpd(>=1.4.39-1),jim(>=0.76-1),jim-oo,jim-sqlite3(>=0.76),jim-cgi(>=0.7-1),jim-binary(>=0.76),service-control(>=2.1),busybox(>=1.20.2-1),lsof(>=4.87),epg(>=1.2.1-1),hmt(>=2.0.9),ssmtp,cron-daemon(>=1.18.3-3),at(>=3.1.18),anacron,trm(>=1.1),openssl-command,nicesplice,id3v2,file,rsvsync(>=1.0.2),webif-charts(>=1.2-1),stripts(>=1.2.5-3),tmenu(>=1.08),ffmpeg,id3v2,multienv(>=1.6),tcpping(>=1.1),e2fsprogs,wireless-tools(>=29-1),dbupdate,recmon(>=2.0.7)
 Suggests:
 Description: An evolving web interface for the Humax.
 Tags: http://hummy.tv/forum/threads/6484/

webif/html/diag/mux.jim

@@ -76,8 +76,8 @@ foreach tw [$db query {
 		set name [system strip $name]
 		if {$lcn >= 800} { incr ehs }
 		switch -glob -- $name {
-			"BBC TWO" -
+			"BBC NEWS" -
-			"BBC THREE" { set mux "PSB1/BBC A" }
+			"BBC FOUR" { set mux "PSB1/BBC A" }
 			"Channel 5" -
 			"ITV2" { set mux "PSB2/D3&4" }
 			"Channel 4 HD" -

webif/lib/fileops

@@ -89,6 +89,36 @@ proc {file write} {target content} {
 	}
 }
 
+set ::fileops::locks {}
+
+proc {file lock} {target} {
+	if {[dict exists $::fileops::locks $target]} {
+		return 0
+	}
+	if {[catch {set fd [open $target w]} msg]} {
+		error "open '$target' failed, $msg"
+	} else {
+		set ret [$fd lock]
+		if {$ret == 1} {
+			set ::fileops::locks($target) $fd
+		} else {
+			$fd close
+		}
+		return $ret
+	}
+}
+
+proc {file unlock} {target} {
+	if {[dict exists $::fileops::locks $target]} {
+		set fd $::fileops::locks($target)
+		dict unset ::fileops::locks $target
+		set ret [$fd unlock]
+		$fd close
+		return $ret
+	}
+	error "$target was not locked."
+}
+
 local proc file {cmd args} {
 	switch $cmd {
 	    rename { tailcall {file rename} {*}$args }
@@ -97,6 +127,8 @@ local proc file {cmd args} {
 	    tdelete { tailcall {file tdelete} {*}$args }
 	    read { tailcall {file read} {*}$args }
 	    write { tailcall {file write} {*}$args }
+	    lock { tailcall {file lock} {*}$args }
+	    unlock { tailcall {file unlock} {*}$args }
 	    default { tailcall upcall file $cmd {*}$args }
 	}
 }

webif/lib/lock

@@ -1,6 +1,10 @@
 #!/mod/bin/jimsh
 
-proc _lock_to_port {id} {
+set ::_lock::locks {}
+
+# For testing, 'ababab' collides with 'b'
+
+proc ::_lock::hash {id} {{hashes {}}} {
 	set len [string length $id]
 	set hash $len
 
@@ -9,16 +13,19 @@ proc _lock_to_port {id} {
 		set hash [expr (($hash<<5)^($hash>>27))^$asc];
 	}
 
-	return [expr (65535 - ($hash % 101))]
+	set hash [expr (65535 - ($hash % 101))]
+
+	while {[dict exists $hashes $hash] && $hashes($hash) ne $id} {
+		#puts "Hash collision."
+		if {[incr hash] > 65535} { set hash 32768 }
+	}
+	set hashes($hash) $id
+
+	return $hash
 }
 
-proc _lock_dummy {newsock addr port} { }
-
 proc acquire_lock {id {timeout 0} {interval 0.2}} {
-	global _locks
+	set port [::_lock::hash $id]
-
-	set port [_lock_to_port $id]
-
 	incr timeout [clock seconds]
 
 	while {[catch {set socket [\
@@ -27,18 +34,17 @@ proc acquire_lock {id {timeout 0} {interval 0.2}} {
 		sleep $interval
 	}
 
-	set _locks($id) $socket
+	set ::_lock::locks($id) $socket
 	return 1
 }
 
 proc release_lock {id} {
-	global _locks
+	if {![dict exists $::_lock::locks $id]} { return 0 }
-
+	if {[catch {close $::_lock::locks($id)} msg]} {
-	if {[catch {close $_locks($id)} msg]} {
 		#puts "Error releasing lock: $msg"
 		return 0
 	}
-	unset _locks($id)
+	unset ::_lock::locks($id)
 	return 1
 }