📄 xmlrpcserver.pm
字号:
# Copyright 2001-2005 Six Apart.# SCRiPTMAFiA 2005 - THE DiRTY HANDS ON YOUR SCRiPTS## $Id: XMLRPCServer.pm 10561 2005-03-21 23:54:46Z ezra $package MT::XMLRPCServer::Util;use Time::Local qw( timegm );use MT::Util qw( offset_time_list );sub mt_new { my $cfg = $ENV{MOD_PERL} ? Apache->request->dir_config('MTConfig') : $MT::XMLRPCServer::MT_DIR . '/mt.cfg'; my $mt = MT->new( Config => $cfg ) or die MT::XMLRPCServer::_fault(MT->errstr); $mt;}# TBD: Refactor me!sub iso2ts { my($blog, $iso) = @_; die MT::XMLRPCServer::_fault("Invalid timestamp format") unless $iso =~ /^(\d{4})(?:-?(\d{2})(?:-?(\d\d?)(?:T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(Z|[+-]\d{2}:\d{2})?)?)?)?/; my($y, $mo, $d, $h, $m, $s, $offset) = ($1, $2 || 1, $3 || 1, $4 || 0, $5 || 0, $6 || 0, $7); if ($offset && !MT::ConfigMgr->instance->IgnoreISOTimezones) { $mo--; $y -= 1900; my $time = timegm($s, $m, $h, $d, $mo, $y); ## If it's not already in UTC, first convert to UTC. if ($offset ne 'Z') { my($sign, $h, $m) = $offset =~ /([+-])(\d{2}):(\d{2})/; $offset = $h * 3600 + $m * 60; $offset *= -1 if $sign eq '-'; $time -= $offset; } ## Now apply the offset for this weblog. ($s, $m, $h, $d, $mo, $y) = offset_time_list($time, $blog); $mo++; $y += 1900; } sprintf "%04d%02d%02d%02d%02d%02d", $y, $mo, $d, $h, $m, $s;}sub ts2iso { my ($blog, $ts) = @_; ($yr, $mo, $dy, $hr, $mn, $sc) = unpack('A4A2A2A2A2A2A2', $ts); $ts = timegm($sc, $mn, $hr, $dy, $mo, $yr); ($sc, $mn, $hr, $dy, $mo, $yr) = offset_time_list($ts, $blog, '-'); $yr += 1900; sprintf("%04d-%02d-%02d %02d:%02d:%02d", $yr, $mo, $dy, $hr, $mn, $sc);}package MT::XMLRPCServer;use strict;use MT;use MT::Util qw( first_n_words decode_html start_background_task);use MT::ErrorHandler;BEGIN { @MT::XMLRPCServer::ISA = qw( MT::ErrorHandler ) }use vars qw( $MT_DIR );my($HAVE_XML_PARSER);BEGIN { eval { require XML::Parser }; $HAVE_XML_PARSER = $@ ? 0 : 1;}sub _fault { SOAP::Fault->faultcode(1)->faultstring($_[0]);}## This is sort of a hack. XML::Parser automatically makes everything## UTF-8, and that is causing severe problems with the serialization## of database records (what happens is this: we construct a string## consisting of pack('N', length($string)) . $string. If the $string SV## is flagged as UTF-8, the packed length is then upgraded to UTF-8,## which turns characters with values greater than 128 into two bytes,## like v194.129. And so on. This is obviously now what we want, because## pack produces a series of bytes, not a string that should be mucked## about with.)#### The following subroutine strips the UTF8 flag from a string, thus## forcing it into a series of bytes. "pack 'C0'" is a magic way of## forcing the following string to be packed as bytes, not as UTF8.sub no_utf8 { for (@_) { next if ref; $_ = pack 'C0A*', $_; }}sub _login { my $class = shift; my($user, $pass, $blog_id) = @_; require MT::Author; my $author = MT::Author->load({ name => $user }) or return; $author->is_valid_password($pass) or return; return $author unless $blog_id; require MT::Permission; my $perms = MT::Permission->load({ author_id => $author->id, blog_id => $blog_id }); ($author, $perms);}sub _publish { my $class = shift; my($mt, $entry, $no_ping) = @_; require MT::Blog; my $blog = MT::Blog->load($entry->blog_id); $mt->rebuild_entry( Entry => $entry, Blog => $blog, BuildDependencies => 1 ) or return $class->error("Rebuild error: " . $mt->errstr); unless ($no_ping) { $mt->ping_and_save(Blog => $blog, Entry => $entry) or return $class->error("Ping error: " . $mt->errstr); } 1;}sub newPost { my $class = shift; my($appkey, $blog_id, $user, $pass, $item, $publish); if ($class eq 'blogger') { ($appkey, $blog_id, $user, $pass, my($content), $publish) = @_; $item->{description} = $content; } else { ($blog_id, $user, $pass, $item, $publish) = @_; } die _fault("No blog_id") unless $blog_id; no_utf8($blog_id, values %$item); unless ($HAVE_XML_PARSER) { for my $f (qw( title description mt_text_more mt_excerpt mt_keywords )) { next unless defined $item->{$f}; $item->{$f} = decode_html($item->{$f}); $item->{$f} =~ s!'!'!g; #' } } my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. require MT::Blog; my $blog = MT::Blog->load($blog_id) or die _fault("Invalid blog ID '$blog_id'"); my($author, $perms) = __PACKAGE__->_login($user, $pass, $blog_id); die _fault("Invalid login") unless $author; die _fault("No posting privileges") unless $perms && $perms->can_post; require MT::Entry; my $entry = MT::Entry->new; $entry->blog_id($blog_id); $entry->author_id($author->id); ## In 2.1 we changed the behavior of the $publish flag. Previously, ## it was used to determine the post status. That was a bad idea. ## So now entries added through XML-RPC are always set to publish, ## *unless* the user has set "NoPublishMeansDraft 1" in mt.cfg, which ## enables the old behavior. if ($mt->{cfg}->NoPublishMeansDraft) { $entry->status($publish ? MT::Entry::RELEASE() : MT::Entry::HOLD()); } else { $entry->status(MT::Entry::RELEASE()); } $entry->allow_comments($blog->allow_comments_default); $entry->allow_pings($blog->allow_pings_default); $entry->convert_breaks(defined $item->{mt_convert_breaks} ? $item->{mt_convert_breaks} : $blog->convert_paras); $entry->allow_comments($item->{mt_allow_comments}) if exists $item->{mt_allow_comments}; $entry->title($item->{title} || first_n_words($item->{description}, 5)); $entry->text($item->{description}); for my $field (qw( allow_pings )) { my $val = $item->{"mt_$field"}; next unless defined $val; die _fault("Value for 'mt_$field' must be either 0 or 1 (was '$val')") unless $val == 0 || $val == 1; $entry->$field($val); } $entry->excerpt($item->{mt_excerpt}) if $item->{mt_excerpt}; $entry->text_more($item->{mt_text_more}) if $item->{mt_text_more}; $entry->keywords($item->{mt_keywords}) if $item->{mt_keywords}; if (my $urls = $item->{mt_tb_ping_urls}) { no_utf8(@$urls); $entry->to_ping_urls(join "\n", @$urls); } if (my $iso = $item->{dateCreated}) { $entry->created_on(MT::XMLRPCServer::Util::iso2ts($blog, $iso)) || die MT::XMLRPCServer::_fault("Invalid timestamp format");; } $entry->save; $mt->log("'" . $author->name . "' added entry #" . $entry->id); if ($publish) { __PACKAGE__->_publish($mt, $entry) or die _fault(__PACKAGE__->errstr); } delete $ENV{SERVER_SOFTWARE}; SOAP::Data->type(string => $entry->id);}sub editPost { my $class = shift; my($appkey, $entry_id, $user, $pass, $item, $publish); if ($class eq 'blogger') { ($appkey, $entry_id, $user, $pass, my($content), $publish) = @_; $item->{description} = $content; } else { ($entry_id, $user, $pass, $item, $publish) = @_; } die _fault("No entry_id") unless $entry_id; no_utf8(values %$item); unless ($HAVE_XML_PARSER) { for my $f (qw( title description mt_text_more mt_excerpt mt_keywords )) { next unless defined $item->{$f}; $item->{$f} = decode_html($item->{$f}); $item->{$f} =~ s!'!'!g; #' } } my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. require MT::Entry; my $entry = MT::Entry->load($entry_id) or die _fault("Invalid entry ID '$entry_id'"); my($author, $perms) = __PACKAGE__->_login($user, $pass, $entry->blog_id); die _fault("Invalid login") unless $author; die _fault("Not privileged to edit entry") unless $perms && $perms->can_edit_entry($entry, $author); $entry->status(MT::Entry::RELEASE()) if $publish; $entry->title($item->{title}) if $item->{title}; $entry->text($item->{description}); $entry->convert_breaks($item->{mt_convert_breaks}) if exists $item->{mt_convert_breaks}; $entry->allow_comments($item->{mt_allow_comments}) if exists $item->{mt_allow_comments}; for my $field (qw( allow_pings )) { my $val = $item->{"mt_$field"}; next unless defined $val; die _fault("Value for 'mt_$field' must be either 0 or 1 (was '$val')") unless $val == 0 || $val == 1; $entry->$field($val); } $entry->excerpt($item->{mt_excerpt}) if defined $item->{mt_excerpt}; $entry->text_more($item->{mt_text_more}) if defined $item->{mt_text_more}; $entry->keywords($item->{mt_keywords}) if defined $item->{mt_keywords}; if (my $urls = $item->{mt_tb_ping_urls}) { no_utf8(@$urls); $entry->to_ping_urls(join "\n", @$urls); } if (my $iso = $item->{dateCreated}) { $entry->created_on(MT::XMLRPCServer::Util::iso2ts($entry->blog_id, $iso)) || die MT::XMLRPCServer::_fault("Invalid timestamp format");; } $entry->save; if ($publish) { __PACKAGE__->_publish($mt, $entry) or die _fault(__PACKAGE__->errstr); } SOAP::Data->type(boolean => 1);}sub getUsersBlogs { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my($appkey, $user, $pass) = @_; my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. my($author) = __PACKAGE__->_login($user, $pass); die _fault("Invalid login") unless $author; require MT::Permission; require MT::Blog; my $iter = MT::Permission->load_iter({ author_id => $author->id }); my @res; while (my $perms = $iter->()) { next unless $perms->can_post; my $blog = MT::Blog->load($perms->blog_id); push @res, { url => SOAP::Data->type(string => $blog->site_url), blogid => SOAP::Data->type(string => $blog->id), blogName => SOAP::Data->type(string => $blog->name) }; } \@res;}sub getUserInfo { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my($appkey, $user, $pass) = @_; my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. my($author) = __PACKAGE__->_login($user, $pass); die _fault("Invalid login") unless $author; my($fname, $lname) = split /\s+/, $author->name; $lname ||= ''; { userid => SOAP::Data->type(string => $author->id), firstname => SOAP::Data->type(string => $fname), lastname => SOAP::Data->type(string => $lname), nickname => SOAP::Data->type(string => $author->nickname), email => SOAP::Data->type(string => $author->email), url => SOAP::Data->type(string => $author->url) };}sub getRecentPosts { my $class = shift; my($blog_id, $user, $pass, $num, $titles_only); if ($class eq 'blogger') { (my($appkey), $blog_id, $user, $pass, $num, $titles_only) = @_; } else { ($blog_id, $user, $pass, $num, $titles_only) = @_; } my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. my($author, $perms) = __PACKAGE__->_login($user, $pass, $blog_id); die _fault("Invalid login") unless $author; die _fault("No posting privileges") unless $perms && $perms->can_post; require MT::Blog; my $blog = MT::Blog->load($blog_id); require MT::Entry; my $iter = MT::Entry->load_iter({ blog_id => $blog_id }, { 'sort' => 'created_on', direction => 'descend', limit => $num }); my @res; while (my $entry = $iter->()) { my $co = sprintf "%04d%02d%02dT%02d:%02d:%02d", unpack 'A4A2A2A2A2A2', $entry->created_on; my $row = { dateCreated => SOAP::Data->type(dateTime => $co), userid => SOAP::Data->type(string => $entry->author_id), postid => SOAP::Data->type(string => $entry->id), }; if ($class eq 'blogger') { $row->{content} = SOAP::Data->type(string => $entry->text); } else { $row->{title} = SOAP::Data->type(string => $entry->title); unless ($titles_only) { $row->{description} = SOAP::Data->type(string => $entry->text); my $link = $entry->permalink; $row->{link} = SOAP::Data->type(string => $link); $row->{permaLink} = SOAP::Data->type(string => $link), $row->{mt_allow_comments} = SOAP::Data->type(int => $entry->allow_comments); $row->{mt_allow_pings} = SOAP::Data->type(int => $entry->allow_pings); $row->{mt_convert_breaks} = SOAP::Data->type(string => $entry->convert_breaks); $row->{mt_text_more} = SOAP::Data->type(string => $entry->text_more); $row->{mt_excerpt} = SOAP::Data->type(string => $entry->excerpt); $row->{mt_keywords} = SOAP::Data->type(string => $entry->keywords); } } push @res, $row; } \@res;}sub getRecentPostTitles { getRecentPosts(@_, 1);}sub deletePost { shift if UNIVERSAL::isa($_[0] => __PACKAGE__); my($appkey, $entry_id, $user, $pass, $publish) = @_; my $mt = MT::XMLRPCServer::Util::mt_new(); ## Will die if MT->new fails. require MT::Entry; my $entry = MT::Entry->load($entry_id) or die _fault("Invalid entry ID '$entry_id'"); my($author, $perms) = __PACKAGE__->_login($user, $pass, $entry->blog_id); die _fault("Invalid login") unless $author; die _fault("Not privileged to delete entry") unless $perms && $perms->can_edit_entry($entry, $author); $entry->remove; if ($publish) { __PACKAGE__->_publish($mt, $entry, 1) or die _fault(__PACKAGE__->errstr); } SOAP::Data->type(boolean => 1);}sub getPost { my $class = shift;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -