Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -N -r1.189.2.90 -r1.189.2.91
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	24 Jun 2021 11:31:50 -0000	1.189.2.90
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	1 Jul 2021 10:36:44 -0000	1.189.2.91
@@ -2696,9 +2696,12 @@
 ad_proc -public util_url_valid_p { query_url } {
     Returns 1 if a URL is a web URL (HTTP, HTTPS or FTP).
 
+    Refined regexp from https://mathiasbynens.be/demo/url-regex
+
     @author Philip Greenspun (philg@mit.edu)
+
 } {
-    return [regexp -nocase {^(http|https|ftp)://[^ ].+} [string trim $query_url]]
+    return [regexp -nocase {^(https?|ftp)://[^\s/$.?#].[^\s]*$} [string trim $query_url]]
 }
 
 ad_proc -public util::min { args } {
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -N -r1.71.2.40 -r1.71.2.41
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	23 May 2021 17:56:50 -0000	1.71.2.40
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl	1 Jul 2021 10:36:45 -0000	1.71.2.41
@@ -890,6 +890,8 @@
     acs_tcl__util_url_valid_p {
     A very rudimentary test of util_url_valid_p
 
+    URL examples extended from https://mathiasbynens.be/demo/url-regex
+
     @creation-date 2004-01-10
     @author Branimir Dolicki (bdolicki@branimir.com)
 } {
@@ -901,6 +903,42 @@
         "HTTP://example.com"
         "http://example.com/foo/bar/blah"
         "http://example.com?foo=bar&bar=foo"
+        "http://foo.com/blah_blah"
+        "http://foo.com/blah_blah/"
+        "http://foo.com/blah_blah_(wikipedia)"
+        "http://foo.com/blah_blah_(wikipedia)_(again)"
+        "http://www.example.com/wpstyle/?p=364"
+        "https://www.example.com/foo/?bar=baz&inga=42&quux"
+        "http://✪df.ws/123"
+        "http://userid:password@example.com:8080"
+        "http://userid:password@example.com:8080/"
+        "http://userid@example.com"
+        "http://userid@example.com/"
+        "http://userid@example.com:8080"
+        "http://userid@example.com:8080/"
+        "http://userid:password@example.com"
+        "http://userid:password@example.com/"
+        "http://142.42.1.1/"
+        "http://142.42.1.1:8080/"
+        "http://➡.ws/䨹"
+        "http://⌘.ws"
+        "http://⌘.ws/"
+        "http://foo.com/blah_(wikipedia)#cite-1"
+        "http://foo.com/blah_(wikipedia)_blah#cite-1"
+        "http://foo.com/unicode_(✪)_in_parens"
+        "http://foo.com/(something)?after=parens"
+        "http://☺.damowmow.com/"
+        "http://code.google.com/events/#&product=browser"
+        "http://j.mp"
+        "ftp://foo.bar/baz"
+        "http://foo.bar/?q=Test%20URL-encoded%20stuff"
+        "http://مثال.إختبار"
+        "http://例子.测试"
+        "http://उदाहरण.परीक्षा"
+        "http://-.~_!$&'()*+,;=:%40:80%2f::::::@example.com"
+        "http://1337.net"
+        "http://a.b-c.de"
+        "http://223.255.255.254"
     } {
         aa_true "Valid web URL $url" [util_url_valid_p "$url"]
     }
@@ -911,6 +949,31 @@
         "mailto:joe@example.com"
         "foo"
         "/foo/bar"
+        "http://"
+        "http://."
+        "http://.."
+        "http://../"
+        "http://?"
+        "http://??"
+        "http://??/"
+        "http://#"
+        "http://##"
+        "http://##/"
+        "http://foo.bar?q=Spaces should be encoded"
+        "//"
+        "//a"
+        "///a"
+        "///"
+        "http:///a"
+        "foo.com"
+        "rdar://1234"
+        "h://test"
+        "http:// shouldfail.com"
+        ":// should fail"
+        "http://foo.bar/foo(bar)baz quux"
+        "ftps://foo.bar/"
+        "http://.www.foo.bar/"
+        "http://.www.foo.bar./"
     } {
         aa_false "Invalid web URL $url" [util_url_valid_p "$url"]
     }