# spf.test - Copyright (C) 2004 Pat Thoyts # # Tests for the Tcllib SPF package # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- # RCS: @(#) $Id: spf.test,v 1.8 2007/08/22 20:37:50 andreas_kupries Exp $ # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.2 testsNeedTcltest 1.0 support { useLocal dns.tcl dns; # tcllib 1.3 useLocal ip.tcl ip; # tcllib 1.7 use log/logger.tcl logger; # tcllib 1.3 use struct/list.tcl struct::list; # tcllib 1.7 use uri/uri.tcl uri; # - clear scheme registry use uri/urn-scheme.tcl uri::urn; # tcllib 1.3 } testing { useLocal spf.tcl spf } # ------------------------------------------------------------------------- # Helpers # ------------------------------------------------------------------------- # These tests do not make any network calls. Instead we emulate the # DNS query results wiht the following functions. foreach cmd [list SPF TXT A PTR MX] { catch {rename ::spf::$cmd ::spf::tmp_$cmd} } proc ::spf::A {name} { return 192.0.2.3 } proc ::spf::AAAA {name} { return 5f05:2000:80ad:5800::1 } proc ::spf::PTR {addr} { return mx.example.org } proc ::spf::MX {domain} { return {{10 mx1.example.org} {20 mx2.example.org}} } proc ::spf::TXT {domain} { return "Only mail from local hosts permitted." } proc ::spf::SPF {domain} { return "v=spf1 ?all" } set email strong-bad@email.example.com # ------------------------------------------------------------------------- # Tests # ------------------------------------------------------------------------- test spf-1.1 {a directive: fallthrough} { list [catch { spf::Spf 192.168.0.1 email.example.com $::email "v=spf1 a -all" } r] $r } {0 -} test spf-1.2 {a directive: fallthrough} { list [catch { spf::Spf 192.168.0.1 email.example.com $::email "v=spf1 a ?all" } r] $r } {0 ?} test spf-1.3 {a directive: matching subnet} { list [catch { spf::Spf 192.0.2.1 email.example.com $::email "v=spf1 a/24 ?all" } r] $r } {0 +} test spf-1.4 {a directive: rejected matching subnet} { list [catch { spf::Spf 192.0.2.1 email.example.com $::email "v=spf1 -a/24 ?all" } r] $r } {0 ?} test spf-1.5 {a directive: match host} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email "v=spf1 a ?all" } r] $r } {0 +} test spf-2.1 {mx directive: fail mx} { list [catch { spf::Spf 192.168.0.1 email.example.com $::email "v=spf1 mx ?all" } r] $r } {0 ?} test spf-2.2 {mx directive: match mx subnet} { list [catch { spf::Spf 192.0.2.1 email.example.com $::email "v=spf1 mx/24 ?all" } r] $r } {0 +} test spf-2.3 {mx directive: fail match explict mx} { list [catch { spf::Spf 192.168.0.1 email.example.com $::email \ "v=spf1 mx:mail.local.net ?all" } r] $r } {0 ?} test spf-2.4 {mx directive: match explict mx} { list [catch { spf::Spf 192.0.2.1 email.example.com $::email \ "v=spf1 mx:mail.local.net/24 ?all" } r] $r } {0 +} test spf-2.5 {mx directive: match explict mx} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 mx:mx2.example.org ?all" } r] $r } {0 +} test spf-3.1 {ptr directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email "v=spf1 ptr ?all" } r] $r } {0 ?} test spf-3.2 {ptr directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email "v=spf1 ptr ?all" } r] $r } {0 ?} test spf-3.3 {ptr directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 ptr:example.org ?all" } r] $r } {0 +} test spf-3.4 {ptr directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 ptr:example.com ?all" } r] $r } {0 ?} test spf-4.1 {ip4 directive} { list [catch { spf::Spf 192.168.2.3 email.example.com $::email \ "v=spf1 ip4:192.0.2.3/32 ?all" } r] $r } {0 ?} test spf-4.2 {ip4 directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 ip4:192.0.2.0/24 ?all" } r] $r } {0 +} test spf-4.3 {ip4 directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 ip4:192.0.0.0/16 ?all" } r] $r } {0 +} test spf-4.4 {ip4 directive} { list [catch { spf::Spf 192.255.2.3 email.example.com $::email \ "v=spf1 ip4:192.0.0.0/16 ?all" } r] $r } {0 ?} test spf-4.5 {ip4 directive} { list [catch { spf::Spf 192.0.2.3 email.example.com $::email \ "v=spf1 ip4:192.0/16 ?all" } r] $r } {0 +} # ------------------------------------------------------------------------- # Macros language tests # These are all taken from the specification document. set Data { %{s} strong-bad@email.example.com %{o} email.example.com %{d} email.example.com %{d4} email.example.com %{d3} email.example.com %{d2} example.com %{d1} com %{dr} com.example.email %{d2r} example.email %{l} strong-bad %{l-} strong.bad %{lr} strong-bad %{lr-} bad.strong %{l1r-} strong %{ir}.%{v}._spf.%{d2} 3.2.0.192.in-addr._spf.example.com %{lr-}.lp._spf.%{d2} bad.strong.lp._spf.example.com %{lr-}.lp.%{ir}.%{v}._spf.%{d2} bad.strong.lp.3.2.0.192.in-addr._spf.example.com %{ir}.%{v}.%{l1r-}.lp._spf.%{d2} 3.2.0.192.in-addr.strong.lp._spf.example.com %{d2}.trusted-domains.example.net example.com.trusted-domains.example.net } set n 0 foreach {macro check} $Data { test spf-5.[incr n] [list spf macro language $macro] { list [catch { ::spf::Expand $macro 192.0.2.3 email.example.com $::email } msg] $msg } [list 0 $check] } set Data { %{ir}.%{v}._spf.%{d2} 1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.5.d.a.0.8.0.0.0.2.5.0.f.5.ip6._spf.example.com } set n 0 foreach {macro check} $Data { test spf-6.0 [list spf macro language ipv6] { list [catch { ::spf::Expand $macro 5f05:2000:80ad:5800::1 \ email.example.com $::email } msg] $msg } [list 0 $check] } # ------------------------------------------------------------------------- foreach cmd [list SPF TXT A PTR MX] { catch {rename ::spf::$cmd {}} catch {rename ::spf::tmp_$cmd ::spf::$cmd} } testsuiteCleanup # Local Variables: # mode: tcl # indent-tabs-mode: nil # End: