Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v
diff -u -r1.84 -r1.85
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	30 Jun 2018 17:59:30 -0000	1.84
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl	11 Jul 2018 15:58:16 -0000	1.85
@@ -1267,8 +1267,10 @@
                         
                         set prot ""
                         
-                        # attribute is a full URL
-                        if {[regexp {^(\w+:)?//(.*)} $url match prot loc]} {
+                        set parsed_url [ns_parseurl $url]
+                        # attribute is a URL including the protocol
+                        set proto [expr {[dict exists $parsed_url proto] ? [dict get $parsed_url proto] : ""}]
+                        if {$proto ne ""} {
                             if {$no_outer_urls_p} {
                                 # no external urls allowed: we still
                                 # want to allow fully specified urls
@@ -1287,22 +1289,23 @@
                                     continue
                                 }
                             }
-                            # this was likely a protocol-relative url
-                            if {$prot eq ""} {
-                                set prot $driver_prot
-                            }
                         }
 
-                        # regexp is for stuff like 'javascript:' pseudoprotocol, that is not really a URL
-                        if {$prot ne "" || [regexp {^(\w+):.*$} $url match prot]} {
-                            # check if protocol is allowed
-                            if {[info exists unallowed_protocol($prot)] ||
-                                ($allowed_protocols ne "*" && ![info exists allowed_protocol($prot)])} {
-                                # invalid attribute!
-                                if {$validate_p} {return 0} else {$node removeAttribute $att}
-                                continue
-                            }
+                        # to check for allowed protocols we need to
+                        # treat URLs without one (e.g. relative or
+                        # protocol-relative URLs) as using our same
+                        # protocol
+                        if {$proto eq ""} {
+                            set proto $driver_prot
                         }
+
+                        # check if protocol is allowed
+                        if {[info exists unallowed_protocol($proto)] ||
+                            ($allowed_protocols ne "*" && ![info exists allowed_protocol($proto)])} {
+                            # invalid attribute!
+                            if {$validate_p} {return 0} else {$node removeAttribute $att}
+                            continue
+                        }
                     }
                 }
             }