[Bug] Problème avec le script zurl.tcl

[T3nS]

Bonjour je possède actuellement le script zurl.tcl (que j'ai renommé url) sur mon eggdrop.
Cependant il m'affiche de nombreuses erreur et je ne sais pas comment corriger ce script n'ayant aucune connaissance en tcl.

Voilà le script en question :

Code :

##############
       #    Zurl    #
       ##############
       
       ############## Zurl.tcl is based on two grabbers urls titles scripts:
       ############## -The first one is a classic grabber who gets all (or most) of urls.
       ############## (http://forum.eggdrop.fr/Titre-des-urls-diffusees-t-1331.html)
       ############## - The second one is a youtube grabber.
       ############## (http://forum.eggdrop.fr/youtube-tiltle-t-1393.html)
       ##############
       ############## So, the youtube and the classic grabber titles on
       ############## one script was the point. I hope it'll be usefull.
       ##############
       ############## Easy to use; you only need to:
       ############## - add the Zurl.tcl file in ../scripts/
       ############## - add the line "source scripts/zurl.tcl" in eggdrop.conf
       ############## - and enjoy.
       ##############
       ############## JazZ (jazz@epiknet.org)
       
       ##############
       #   Script   #
       ##############
       
       set Zurlversion "1.0"
       
       ############## Binds/Packages
       
       package require http
       package require uri
       package require tls
       
       tls::init -tls1 true -ssl2 false -ssl3 false
       http::register https 443 tls::socket
       
       bind PUBM - * check_url
       
       ############## Classic Proc
       
       proc check_url {nick uhost handle chan text} {
               if {![string match "*?://*?" $text] && ![regexp {^[0-9\.]+$} $text] } {
                       set text "http://$text"
               }
               if {[regexp -- {([a-z0-9\-]+\://[a-z0-9\-]+\.[a-z0-9\-\.]+(?:/|(?:/[a-zA-Z0-9!#\$%&'\*\+,\-\.:;=\?@\[\]_~]+)*))} $text match url]} {
                               set url [string tolower $url]
                               set url [string map -nocase { "&" "&" } $url]
                               set token [geturl $url]
                               set html_data [::http::data $token]
                               ::http::cleanup $token
                               regexp -all -nocase -- "<title>(.*)</title>" $html_data match title
                               if { [info exists title] } {
                                   putserv "PRIVMSG $chan .: \002URL\002 :. '[html_entities_decode $title]'"
                               }
               }
               return 0
       }
       
       proc geturl {url args} {
           array set URI [::uri::split $url];
           while {1} {
              set token [eval [list http::geturl $url] $args]
              if {![string match {30[1237]} [::http::ncode $token]]} {return $token}
              array set meta [set ${token}(meta)]
              if {![info exist meta(Location)]} {
                   return $token
              }
              array set uri [::uri::split $meta(Location)]
              unset meta
              if {$uri(host) == ""} { set uri(host) $URI(host) }
              set url [eval ::uri::join [array get uri]]
           }
       }      
       putlog "Zurl-$Zurlversion.tcl loaded"

Et voilà les erreurs qu'il me provoque dans les logs :

[15:41:41] 05--04--->14 unknown scheme 'ttps' in 'ttps://www.facebook.com/photo.php?fbid=10203787935398184&set=g.548153875302053&type=1&theater'

Il est possible que cela vienne du protocole genre ttps:// avec le h en moins (je pense que ça vient du script, ça le fait trop souvent pour que ça soit accidentel) et parfois aussi sur des protocoles qu'il n'a pas à tester genre mumble://

D'après MenzAgitat qui a jeté un coup d’œil le problème est provoqué par le package http en fait, ça vient du fait que le script balance des url malformées à la proc geturl du package http

Voilà merci d'avance pour votre aide.