| 1 | use strict; |
|---|
| 2 | use lib 't/lib', 'extlib', 'lib', '../lib', '../extlib'; |
|---|
| 3 | use POSIX; |
|---|
| 4 | |
|---|
| 5 | use MT; |
|---|
| 6 | use MT::Atom; |
|---|
| 7 | use XML::LibXML; # this test would not work without it |
|---|
| 8 | use XML::XPath; |
|---|
| 9 | use XML::Atom; |
|---|
| 10 | use XML::Atom::Feed; |
|---|
| 11 | use XML::Atom::Entry; |
|---|
| 12 | |
|---|
| 13 | use Test::More tests => 37; |
|---|
| 14 | |
|---|
| 15 | # To keep away from being under FastCGI |
|---|
| 16 | $ENV{HTTP_HOST} = 'localhost'; |
|---|
| 17 | |
|---|
| 18 | use vars qw( $DB_DIR $T_CFG ); |
|---|
| 19 | my $mt = MT->new( Config => $T_CFG ) or die MT->errstr; |
|---|
| 20 | isa_ok($mt, 'MT'); |
|---|
| 21 | |
|---|
| 22 | use MT::Test qw(:db :data); |
|---|
| 23 | |
|---|
| 24 | my %test_data; |
|---|
| 25 | $test_data{'/mt-atom.cgi/weblog'} = <<XML1; |
|---|
| 26 | <?xml version="1.0" encoding="utf-8"?> |
|---|
| 27 | <entry xmlns="http://purl.org/atom/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/"> |
|---|
| 28 | <title>Fight the Power</title> |
|---|
| 29 | <content>Elvis was a hero to most but he never meant shit to me</content> |
|---|
| 30 | <issued>2004-08-06T00:43:34+01:00</issued> |
|---|
| 31 | </entry> |
|---|
| 32 | XML1 |
|---|
| 33 | $test_data{'/mt-atom.cgi/1.0'} = <<XML2; |
|---|
| 34 | <?xml version="1.0" encoding="utf-8"?> |
|---|
| 35 | <entry xmlns="http://www.w3.org/2005/Atom"> |
|---|
| 36 | <title>Fight the Power</title> |
|---|
| 37 | <content type="html">Elvis was a hero to most but he never meant shit to me</content> |
|---|
| 38 | <published>2004-08-06T00:43:34+01:00</published> |
|---|
| 39 | </entry> |
|---|
| 40 | XML2 |
|---|
| 41 | |
|---|
| 42 | my %feed_link = ( |
|---|
| 43 | '/mt-atom.cgi/weblog' => sub { |
|---|
| 44 | my ($resp) = @_; |
|---|
| 45 | my $feed = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 46 | ok($feed, 'got feed'); |
|---|
| 47 | my ($sfeed) = grep { |
|---|
| 48 | $_->rel eq 'service.feed' |
|---|
| 49 | } $feed->links; |
|---|
| 50 | $sfeed->href; |
|---|
| 51 | }, |
|---|
| 52 | '/mt-atom.cgi/1.0' => sub { |
|---|
| 53 | my ($resp) = @_; |
|---|
| 54 | my $feed = XML::XPath->new(xml => $resp->content()); |
|---|
| 55 | ok($feed, 'got feed'); |
|---|
| 56 | my $col = $feed->getNodeText('/service/workspace[1]/collection/@href'); |
|---|
| 57 | $col; |
|---|
| 58 | } |
|---|
| 59 | ); |
|---|
| 60 | |
|---|
| 61 | my $username = 'Chuck D'; |
|---|
| 62 | my $chuck = MT::Author->load({name => $username}) |
|---|
| 63 | or die "Couldn't load $username"; |
|---|
| 64 | my $chuck_token = $chuck->api_password; |
|---|
| 65 | |
|---|
| 66 | # not a good nonce-maker |
|---|
| 67 | my @hexch = ('0' .. '9', 'a' .. 'f'); |
|---|
| 68 | sub make_nonce { |
|---|
| 69 | join '', map { $hexch[rand() * @hexch] } (0..7); |
|---|
| 70 | } |
|---|
| 71 | sub make_wsse { |
|---|
| 72 | my ($password) = @_; |
|---|
| 73 | my $timestamp = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time)); |
|---|
| 74 | my $nonce = make_nonce(); |
|---|
| 75 | my $PasswordDigest = sha1_base64($nonce . $timestamp . $chuck_token); |
|---|
| 76 | # print "# PasswordDigest is sha1('$nonce$timestamp$chuck_token')\n"; |
|---|
| 77 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 78 | return "UserNameToken Username=\"$username\", " |
|---|
| 79 | . "PasswordDigest=\"$PasswordDigest\", Nonce=\"$nonce\", " |
|---|
| 80 | . "Created=\"$timestamp\""; |
|---|
| 81 | } |
|---|
| 82 | |
|---|
| 83 | require LWP::UserAgent::Local; |
|---|
| 84 | my $ua = new LWP::UserAgent::Local({ ScriptAlias => '/' }); |
|---|
| 85 | |
|---|
| 86 | foreach my $base_uri ( qw{/mt-atom.cgi/weblog /mt-atom.cgi/1.0 } ) { |
|---|
| 87 | { |
|---|
| 88 | # # # # First try a req with baloney auth, make sure it fails |
|---|
| 89 | # TBD: Try more bogus auth varieties |
|---|
| 90 | my $nonce = make_nonce(); |
|---|
| 91 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 92 | |
|---|
| 93 | my $uri = new URI(); |
|---|
| 94 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 95 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 96 | $req->header(Authentication => 'Atom'); |
|---|
| 97 | $req->header('X-WSSE' => "UserNameToken Username=\"Melody\", PasswordDigest=\"Oj12fART+XZvBZBe39vVvkirg4w\", Nonce=\"" . $nonce . "\", Created=\"2004-05-19T20:08:57Z\""); |
|---|
| 98 | print "# requesting: " . $req->uri . "\n"; |
|---|
| 99 | my $resp = $ua->request($req); |
|---|
| 100 | |
|---|
| 101 | print "# response code was: " . $resp->code . "\n"; |
|---|
| 102 | print "# content was: " . $resp->content . "\n";# if !$resp->code(); |
|---|
| 103 | ok($resp->is_error()); |
|---|
| 104 | } |
|---|
| 105 | |
|---|
| 106 | # test blog lists |
|---|
| 107 | { |
|---|
| 108 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 109 | my $uri = new URI; |
|---|
| 110 | $uri->path($base_uri); |
|---|
| 111 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 112 | $req->header('Authorization' => 'Atom'); |
|---|
| 113 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 114 | |
|---|
| 115 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 116 | |
|---|
| 117 | my $resp = $ua->request($req); |
|---|
| 118 | if (ok($resp->is_success)) { |
|---|
| 119 | my $blog_feed_url = $feed_link{$base_uri}->($resp); |
|---|
| 120 | my $uri = new URI($blog_feed_url); |
|---|
| 121 | is($uri->path, $base_uri . '/blog_id=1', 'blog feed url is correct'); |
|---|
| 122 | } |
|---|
| 123 | else { |
|---|
| 124 | die 'failed to retrieve blog feed'; |
|---|
| 125 | } |
|---|
| 126 | } |
|---|
| 127 | |
|---|
| 128 | # test blog feed |
|---|
| 129 | { |
|---|
| 130 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 131 | my $uri = new URI; |
|---|
| 132 | $uri->path($base_uri . "/blog_id=1"); |
|---|
| 133 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 134 | $req->header('Authorization' => 'Atom'); |
|---|
| 135 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 136 | |
|---|
| 137 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 138 | |
|---|
| 139 | my $resp = $ua->request($req); |
|---|
| 140 | if (ok($resp->is_success)) { |
|---|
| 141 | my $feed = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 142 | ok($feed, 'got feed'); |
|---|
| 143 | is($feed->title, 'none'); |
|---|
| 144 | my ($alternate) = grep { |
|---|
| 145 | $_->rel eq 'alternate' && $_->type eq 'text/html' |
|---|
| 146 | } $feed->links; |
|---|
| 147 | is($alternate->href, 'http://narnia.na/nana/', 'blog url is correct'); |
|---|
| 148 | my $entry_count = MT::Entry->count( |
|---|
| 149 | { blog_id => 1 }, |
|---|
| 150 | { limit => 21 }, |
|---|
| 151 | ); |
|---|
| 152 | my @entries = $feed->entries; |
|---|
| 153 | is($entry_count, scalar(@entries), 'number of entries is correct'); |
|---|
| 154 | } |
|---|
| 155 | else { |
|---|
| 156 | die 'failed to retrieve blog feed'; |
|---|
| 157 | } |
|---|
| 158 | } |
|---|
| 159 | |
|---|
| 160 | my $entry_id; |
|---|
| 161 | |
|---|
| 162 | use constant USE_DIGEST => 0; |
|---|
| 163 | |
|---|
| 164 | if (USE_DIGEST) |
|---|
| 165 | { |
|---|
| 166 | # # # # # # # use this to do a Digest auth with MD5 as the algorithm. |
|---|
| 167 | my $realm = 'movabletype'; |
|---|
| 168 | # $username = shift; |
|---|
| 169 | # $hashed_pwd = shift; |
|---|
| 170 | require Digest::MD5; |
|---|
| 171 | my $hashed_pwd = Digest::MD5::md5(join ':', $username, $realm, $chuck_token); |
|---|
| 172 | my $method = 'POST'; |
|---|
| 173 | |
|---|
| 174 | my $uri = new URI; |
|---|
| 175 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 176 | my $req = new HTTP::Request(POST => $uri); |
|---|
| 177 | |
|---|
| 178 | my $resp = $ua->simple_request($req); |
|---|
| 179 | ok($resp->is_error()); |
|---|
| 180 | my $auth_header = $resp->header('WWW-Authenticate'); |
|---|
| 181 | my ($nonce) = $auth_header =~ /nonce=(\S*)/; |
|---|
| 182 | |
|---|
| 183 | my $A1 = pack('H*', $hashed_pwd); |
|---|
| 184 | my $A2 = $method . ':' . $uri; |
|---|
| 185 | |
|---|
| 186 | require Digest::MD5; |
|---|
| 187 | my $hash = \&Digest::MD5::md5; |
|---|
| 188 | my $kd = sub { $hash->($_[0].':'.$_[1]) }; |
|---|
| 189 | |
|---|
| 190 | print STDERR "Signing ", join(':', |
|---|
| 191 | $nonce, |
|---|
| 192 | '', |
|---|
| 193 | '', |
|---|
| 194 | 'auth', |
|---|
| 195 | $hash->($A2)), "\n"; |
|---|
| 196 | print STDERR "with key ", $hash->($A1), "\n"; |
|---|
| 197 | |
|---|
| 198 | my $response = $kd->($hash->($A1), join(':', |
|---|
| 199 | $nonce, |
|---|
| 200 | '', |
|---|
| 201 | '', |
|---|
| 202 | 'auth', |
|---|
| 203 | $hash->($A2))); |
|---|
| 204 | print "# ", ($response = unpack('H*', $response)), "\n"; |
|---|
| 205 | |
|---|
| 206 | $uri = new URI; |
|---|
| 207 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 208 | $req = new HTTP::Request(POST => $uri); |
|---|
| 209 | |
|---|
| 210 | $req->header('X-Atom-Authorization', "Digest nonce=$nonce, username=$username, realm=movabletype, uri=$uri, qop=auth, response=$response"); |
|---|
| 211 | print "# sending: ", $req->header('X-Atom-Authorization'); |
|---|
| 212 | |
|---|
| 213 | $req->content($test_data{$base_uri}); |
|---|
| 214 | |
|---|
| 215 | $resp = $ua->simple_request($req); |
|---|
| 216 | |
|---|
| 217 | print "# " . $resp->code . " " . $resp->message . "\n"; |
|---|
| 218 | print "# " . $resp->content . "\n"; |
|---|
| 219 | ok($resp->is_success()); |
|---|
| 220 | |
|---|
| 221 | print "##\n". $resp->header('Location') . "\n##\n"; |
|---|
| 222 | my $location = $resp->header('Location') |
|---|
| 223 | || die "No Location: header. Did get\n" |
|---|
| 224 | . $resp->code() . $resp->message() . "\n" |
|---|
| 225 | . $resp->headers_as_string() . "\n" |
|---|
| 226 | . $resp->content(); |
|---|
| 227 | ($entry_id) = ($location =~ /entry_id=(\d+)/); |
|---|
| 228 | |
|---|
| 229 | $entry_id || die "Couldn't get entry ID from header Location: " |
|---|
| 230 | . $location; |
|---|
| 231 | |
|---|
| 232 | print "# entry ID is $entry_id\n"; |
|---|
| 233 | |
|---|
| 234 | ok($entry_id); |
|---|
| 235 | } |
|---|
| 236 | |
|---|
| 237 | unless (USE_DIGEST) |
|---|
| 238 | { |
|---|
| 239 | print "# Doing Digest auth\n"; |
|---|
| 240 | # # # # Now try posting an entry with authentication |
|---|
| 241 | my $nonce = make_nonce(); |
|---|
| 242 | my $timestamp = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time)); |
|---|
| 243 | use Digest::SHA1 qw(sha1_base64); |
|---|
| 244 | my $PasswordDigest = sha1_base64($nonce . $timestamp . $chuck_token); |
|---|
| 245 | |
|---|
| 246 | # print STDERR ("Client hashing (", |
|---|
| 247 | # unpack('H*', $nonce . $timestamp . $chuck_token), ")\n"); |
|---|
| 248 | # print STDERR " produces: $PasswordDigest\n"; |
|---|
| 249 | |
|---|
| 250 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 251 | |
|---|
| 252 | print "# nonce: $nonce\n"; |
|---|
| 253 | |
|---|
| 254 | my $dir = `pwd`; chomp $dir; |
|---|
| 255 | while (! -x ($dir . "/mt-atom.cgi")) { |
|---|
| 256 | $dir =~ s!(/[^/]*)$!!; |
|---|
| 257 | last if $dir =~ m!^/?$!; |
|---|
| 258 | } |
|---|
| 259 | |
|---|
| 260 | my $uri = new URI; |
|---|
| 261 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 262 | my $req = new HTTP::Request(POST => $uri); |
|---|
| 263 | $req->header('Authorization' => 'Atom'); |
|---|
| 264 | $req->header('X-WSSE' => "UserNameToken Username=\"$username\", " |
|---|
| 265 | . "PasswordDigest=\"$PasswordDigest\", Nonce=\"$nonce\", " |
|---|
| 266 | . "Created=\"$timestamp\""); |
|---|
| 267 | |
|---|
| 268 | $req->content($test_data{$base_uri}); |
|---|
| 269 | |
|---|
| 270 | my $resp = $ua->simple_request($req); |
|---|
| 271 | |
|---|
| 272 | print "######### RESPONSE #########\n"; |
|---|
| 273 | print "# " . $resp->code . " " . $resp->message . "\n"; |
|---|
| 274 | my $content = $resp->content; |
|---|
| 275 | $content =~ s/^/# /gm; |
|---|
| 276 | print $content; |
|---|
| 277 | print "#########~RESPONSE #########\n"; |
|---|
| 278 | ok($resp->is_success()); |
|---|
| 279 | |
|---|
| 280 | #print "##\n". $resp->header('Location') . "\n##\n"; |
|---|
| 281 | my $location = $resp->header('Location') |
|---|
| 282 | || die "No Location: header. Did get\n" |
|---|
| 283 | . $resp->headers_as_string() . "\n" |
|---|
| 284 | . $resp->content(); |
|---|
| 285 | ($entry_id) = ($location =~ /entry_id=(\d+)/); |
|---|
| 286 | |
|---|
| 287 | $entry_id || die "Couldn't get entry ID from header Location: " |
|---|
| 288 | . $location; |
|---|
| 289 | |
|---|
| 290 | print "# entry ID is $entry_id\n"; |
|---|
| 291 | |
|---|
| 292 | ok($entry_id); |
|---|
| 293 | my $atom_obj = XML::Atom::Entry->new(\$resp->content()); |
|---|
| 294 | require Date::Parse; |
|---|
| 295 | print "# ", $atom_obj->issued(), "\n"; |
|---|
| 296 | is(Date::Parse::str2time($atom_obj->issued()), |
|---|
| 297 | Date::Parse::str2time('2004-08-06T00:43:34+01:00'), $atom_obj->issued()); |
|---|
| 298 | } |
|---|
| 299 | |
|---|
| 300 | { |
|---|
| 301 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 302 | my $uri = new URI; |
|---|
| 303 | $uri->path($base_uri . "/blog_id=1/entry_id=$entry_id"); |
|---|
| 304 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 305 | $req->header('Authorization' => 'Atom'); |
|---|
| 306 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 307 | |
|---|
| 308 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 309 | |
|---|
| 310 | my $resp = $ua->request($req); |
|---|
| 311 | |
|---|
| 312 | my $atom_entry = XML::Atom::Entry->new(Stream => \$resp->content()); |
|---|
| 313 | |
|---|
| 314 | is($atom_entry->title(), "Fight the Power"); |
|---|
| 315 | is($atom_entry->author()->name(), $chuck->nickname); |
|---|
| 316 | is($atom_entry->content()->body(), |
|---|
| 317 | "Elvis was a hero to most but he never meant shit to me"); |
|---|
| 318 | |
|---|
| 319 | $wsse_header = make_wsse($chuck_token); |
|---|
| 320 | $uri = new URI; |
|---|
| 321 | $uri->path($base_uri . "/blog_id=1/entry_id=$entry_id"); |
|---|
| 322 | $req = new HTTP::Request(PUT => $uri); |
|---|
| 323 | $req->header('Authorization' => 'Atom'); |
|---|
| 324 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 325 | my $body = $atom_entry->as_xml(); |
|---|
| 326 | $req->content($body); |
|---|
| 327 | |
|---|
| 328 | $resp = $ua->request($req); |
|---|
| 329 | |
|---|
| 330 | if (ok($resp->is_success)) { |
|---|
| 331 | $atom_entry = XML::Atom::Entry->new(Stream => \$resp->content()); |
|---|
| 332 | is($atom_entry->title, "Fight the Power"); |
|---|
| 333 | is(Date::Parse::str2time($atom_entry->issued), |
|---|
| 334 | Date::Parse::str2time("2004-08-05T21:13:34-0230")); |
|---|
| 335 | } else { |
|---|
| 336 | print STDERR "# PUT request returned ", $resp->status_line(), "\n"; |
|---|
| 337 | skip(1); |
|---|
| 338 | skip(1); |
|---|
| 339 | } |
|---|
| 340 | } |
|---|
| 341 | |
|---|
| 342 | } #end foreach |
|---|
| 343 | |
|---|
| 344 | |
|---|
| 345 | END { |
|---|
| 346 | #my $melody = MT::Author->load({ name => $username }); |
|---|
| 347 | #$melody->delete() if $melody; |
|---|
| 348 | } |
|---|