534 lines
15 KiB
Perl
534 lines
15 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# DW::Controller::Interface::AtomAPI
|
||
|
|
#
|
||
|
|
# This controller is for the Atom Publishing Protocol interface
|
||
|
|
#
|
||
|
|
# Authors:
|
||
|
|
# Afuna <coder.dw@afunamatata.com>
|
||
|
|
#
|
||
|
|
# Copyright (c) 2011 by Dreamwidth Studios, LLC.
|
||
|
|
#
|
||
|
|
# This program is free software; you may redistribute it and/or modify it under
|
||
|
|
# the same terms as Perl itself. For a copy of the license, please reference
|
||
|
|
# 'perldoc perlartistic' or 'perldoc perlgpl'.
|
||
|
|
#
|
||
|
|
|
||
|
|
package DW::Controller::Interface::AtomAPI;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use DW::Routing;
|
||
|
|
use LJ::ParseFeed;
|
||
|
|
|
||
|
|
use XML::Atom::Entry;
|
||
|
|
use XML::Atom::Category;
|
||
|
|
use Digest::SHA1;
|
||
|
|
use MIME::Base64;
|
||
|
|
|
||
|
|
use HTTP::Status qw( :constants );
|
||
|
|
|
||
|
|
use LJ::Protocol;
|
||
|
|
|
||
|
|
use DW::Auth;
|
||
|
|
|
||
|
|
# service document URL is the same for all users
|
||
|
|
DW::Routing->register_string(
|
||
|
|
"/interface/atom", \&service_document,
|
||
|
|
app => 1,
|
||
|
|
format => "atom",
|
||
|
|
methods => { GET => 1 }
|
||
|
|
);
|
||
|
|
|
||
|
|
# note: safe to put these pages in the user subdomain even if they modify data
|
||
|
|
# because we don't use cookies (so even if a user's cookies are stolen...)
|
||
|
|
DW::Routing->register_string(
|
||
|
|
"/interface/atom/entries", \&entries_handler,
|
||
|
|
user => 1,
|
||
|
|
format => "atom",
|
||
|
|
methods => { POST => 1, GET => 1 }
|
||
|
|
);
|
||
|
|
DW::Routing->register_string(
|
||
|
|
"/interface/atom/entries/tags", \&categories_document,
|
||
|
|
user => 1,
|
||
|
|
format => "atom",
|
||
|
|
methods => { GET => 1 }
|
||
|
|
);
|
||
|
|
DW::Routing->register_regex(
|
||
|
|
qr#^/interface/atom/entries/(\d+)$#, \&entry_handler,
|
||
|
|
user => 1,
|
||
|
|
format => "atom",
|
||
|
|
methods => { GET => 1, PUT => 1, DELETE => 1 }
|
||
|
|
);
|
||
|
|
|
||
|
|
sub ok {
|
||
|
|
my ( $message, $status, $content_type ) = @_;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
$r->status( $status || HTTP_OK );
|
||
|
|
$r->content_type( $content_type || "application/atom+xml" );
|
||
|
|
|
||
|
|
$r->print($message);
|
||
|
|
|
||
|
|
return $r->OK;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub err {
|
||
|
|
my ( $message, $status ) = @_;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
$r->status( $status || HTTP_NOT_FOUND );
|
||
|
|
$r->content_type('text/plain');
|
||
|
|
|
||
|
|
$r->print($message);
|
||
|
|
|
||
|
|
return $r->OK;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub check_enabled {
|
||
|
|
return ( 0, err ("This server does not support the Atom API.") )
|
||
|
|
unless LJ::ModuleCheck->have_xmlatom;
|
||
|
|
|
||
|
|
return (1);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub authenticate {
|
||
|
|
my (%opts) = @_;
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
my ($remote) = DW::Auth->authenticate(
|
||
|
|
wsse => { allow_duplicate_nonce => $opts{allow_duplicate_nonce} || 0 },
|
||
|
|
digest => 1
|
||
|
|
);
|
||
|
|
my $u = LJ::load_user( $opts{journal} ) || $remote;
|
||
|
|
|
||
|
|
return ( 0, err ( "Authentication failed for this AtomAPI request.", $r->HTTP_UNAUTHORIZED ) )
|
||
|
|
if !$remote;
|
||
|
|
|
||
|
|
return (
|
||
|
|
0,
|
||
|
|
err
|
||
|
|
(
|
||
|
|
"User $remote->{user} has no posting access to account $u->{user}.",
|
||
|
|
$r->HTTP_UNAUTHORIZED
|
||
|
|
)
|
||
|
|
) if !$remote->can_post_to($u);
|
||
|
|
|
||
|
|
return ( 1, { u => $u, remote => $remote } );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _create_workspace {
|
||
|
|
my ($u) = @_;
|
||
|
|
|
||
|
|
my $atom_base = $u->atom_base;
|
||
|
|
my $title = LJ::exml( $u->prop("journaltitle") || $u->user );
|
||
|
|
|
||
|
|
my $ret = qq{
|
||
|
|
<workspace>
|
||
|
|
<atom:title>$title</atom:title>
|
||
|
|
};
|
||
|
|
|
||
|
|
# entries
|
||
|
|
$ret .= qq{<collection href="$atom_base/entries">
|
||
|
|
<atom:title>Entries</atom:title>
|
||
|
|
<accept>application/atom+xml;type=entry</accept>
|
||
|
|
<categories href="$atom_base/entries/tags" />
|
||
|
|
</collection>
|
||
|
|
};
|
||
|
|
|
||
|
|
# add media, etc collections when available
|
||
|
|
|
||
|
|
$ret .= "</workspace>";
|
||
|
|
|
||
|
|
return $ret;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub service_document {
|
||
|
|
my ($call_info) = @_;
|
||
|
|
|
||
|
|
my ( $ok, $rv ) = check_enabled();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
# detect the user's journal based on the account they log in as
|
||
|
|
# not based on the journal subdomain they are currently trying to view
|
||
|
|
# (since we're not on a subdomain)
|
||
|
|
( $ok, $rv ) = authenticate();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
# FIXME: use XML::Atom::Service?
|
||
|
|
my $ret = qq{<?xml version="1.0"?>};
|
||
|
|
$ret .=
|
||
|
|
qq{<service xmlns="http://www.w3.org/2007/app" xmlns:atom="http://www.w3.org/2005/Atom">};
|
||
|
|
|
||
|
|
$ret .= _create_workspace( $rv->{u} );
|
||
|
|
|
||
|
|
my @comms = $rv->{u}->posting_access_list;
|
||
|
|
$ret .= _create_workspace($_) foreach @comms;
|
||
|
|
|
||
|
|
$ret .= "</service>";
|
||
|
|
|
||
|
|
return ok( $ret, $r->OK, "application/atomsvc+xml; charset=utf-8" );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub categories_document {
|
||
|
|
my ($call_info) = @_;
|
||
|
|
|
||
|
|
my ( $ok, $rv ) = check_enabled();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
( $ok, $rv ) = authenticate( journal => $call_info->username );
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
my $u = $rv->{u};
|
||
|
|
my $remote = $rv->{remote};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
my $ret = qq{<?xml version="1.0"?>};
|
||
|
|
$ret .=
|
||
|
|
qq{<categories xmlns="http://www.w3.org/2007/app" xmlns:atom="http://www.w3.org/2005/Atom">};
|
||
|
|
|
||
|
|
my $tags = LJ::Tags::get_usertags( $u, { remote => $remote } ) || {};
|
||
|
|
foreach ( sort { $a->{name} cmp $b->{name} } values %$tags ) {
|
||
|
|
my $name = LJ::exml( $_->{name} );
|
||
|
|
$ret .= qq{<atom:category term="$name" />};
|
||
|
|
}
|
||
|
|
|
||
|
|
$ret .= '</categories>';
|
||
|
|
|
||
|
|
return ok( $ret, $r->OK, "application/atomcat+xml; charset=utf-8" );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub entries_handler {
|
||
|
|
my ($call_info) = @_;
|
||
|
|
|
||
|
|
my ( $ok, $rv ) = check_enabled();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
( $ok, $rv ) = authenticate( allow_duplicate_nonce => 1, journal => $call_info->username );
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
return _create_entry(%$rv) if $r->method eq "POST";
|
||
|
|
return _list_entries(%$rv) if $r->method eq "GET";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _create_entry {
|
||
|
|
my (%opts) = @_;
|
||
|
|
my $u = $opts{u};
|
||
|
|
my $remote = $opts{remote};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
my ( $buff, $len, $entry );
|
||
|
|
|
||
|
|
unless ($buff) {
|
||
|
|
|
||
|
|
# check length
|
||
|
|
$len = $r->header_in("Content-length");
|
||
|
|
return err ( "Content is too long", $r->HTTP_BAD_REQUEST )
|
||
|
|
if $len > $LJ::MAX_ATOM_UPLOAD;
|
||
|
|
|
||
|
|
# read the content
|
||
|
|
$r->read( $buff, $len );
|
||
|
|
}
|
||
|
|
|
||
|
|
# try parsing
|
||
|
|
eval { $entry = XML::Atom::Entry->new( \$buff ); };
|
||
|
|
return err ("Could not parse the entry due to invalid markup.\n\n $@")
|
||
|
|
if $@;
|
||
|
|
|
||
|
|
# remove the SvUTF8 flag. See same code in LJ::SynSuck for
|
||
|
|
# an explanation
|
||
|
|
$entry->title( LJ::no_utf8_flag( $entry->title ) );
|
||
|
|
$entry->link( LJ::no_utf8_flag( $entry->link ) );
|
||
|
|
$entry->content( LJ::no_utf8_flag( $entry->content->body ) )
|
||
|
|
if $entry->content;
|
||
|
|
|
||
|
|
# extract the list of tags from the provided categories
|
||
|
|
my @tags = map { LJ::no_utf8_flag( $_->term ) } $entry->category;
|
||
|
|
|
||
|
|
# post to the protocol
|
||
|
|
# we ignore some things provided by the user,
|
||
|
|
# such as the entry id, and the update time
|
||
|
|
# FIXME: use an XML::Atom extension to add security options
|
||
|
|
my $req = {
|
||
|
|
ver => 1,
|
||
|
|
username => $remote->user,
|
||
|
|
usejournal => !$remote->equals($u) ? $u->user : undef,
|
||
|
|
lineendings => 'unix',
|
||
|
|
subject => $entry->title,
|
||
|
|
event => $entry->content->body,
|
||
|
|
props => { taglist => \@tags, },
|
||
|
|
tz => 'guess',
|
||
|
|
};
|
||
|
|
|
||
|
|
$req->{props}->{interface} = "atom";
|
||
|
|
|
||
|
|
my $err;
|
||
|
|
my $res = LJ::Protocol::do_request( "postevent", $req, \$err, { noauth => 1 } );
|
||
|
|
if ($err) {
|
||
|
|
my $errstr = LJ::Protocol::error_message($err);
|
||
|
|
return err ( "Unable to post new entry. Protocol error: $errstr", $r->HTTP_SERVER_ERROR );
|
||
|
|
}
|
||
|
|
|
||
|
|
my $entry_obj = LJ::Entry->new( $u, jitemid => $res->{itemid} );
|
||
|
|
my $atom_reply = $entry_obj->atom_entry( apilinks => 1, synlevel => 'full' );
|
||
|
|
|
||
|
|
$r->header_out( "Location", $entry_obj->atom_url );
|
||
|
|
return ok( $atom_reply->as_xml, $r->HTTP_CREATED );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _list_entries {
|
||
|
|
my (%opts) = @_;
|
||
|
|
my $u = $opts{u};
|
||
|
|
my $remote = $opts{remote};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
# simulate a call to the S1 data view creator, with appropriate options
|
||
|
|
my %op = (
|
||
|
|
pathextra => "/atom",
|
||
|
|
apilinks => 1,
|
||
|
|
);
|
||
|
|
my $ret = LJ::Feed::make_feed( $r, $u, $remote, \%op );
|
||
|
|
|
||
|
|
unless ( defined $ret ) {
|
||
|
|
if ( $op{redir} ) {
|
||
|
|
|
||
|
|
# this happens if the account was renamed or a syn account.
|
||
|
|
# the redir URL is wrong because LJ::Feed is too
|
||
|
|
# dataview-specific. Since this is an admin interface, we can
|
||
|
|
# just fail.
|
||
|
|
return err
|
||
|
|
(
|
||
|
|
qq{The account "$u->{user}" is of a wrong type and does not allow AtomAPI administration.},
|
||
|
|
$r->NOT_FOUND
|
||
|
|
);
|
||
|
|
}
|
||
|
|
if ( $op{handler_return} ) {
|
||
|
|
|
||
|
|
# this could be a conditional GET shortcut, honor it
|
||
|
|
$r->status( $op{handler_return} );
|
||
|
|
return $r->OK;
|
||
|
|
}
|
||
|
|
|
||
|
|
# should never get here
|
||
|
|
return err ( "Unknown error", $r->NOT_FOUND );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ok($ret);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub entry_handler {
|
||
|
|
my ( $call_info, $jitemid ) = @_;
|
||
|
|
|
||
|
|
my ( $ok, $rv ) = check_enabled();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
( $ok, $rv ) = authenticate( journal => $call_info->username, allow_duplicate_nonce => 1 );
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
my $u = $rv->{u};
|
||
|
|
my $remote = $rv->{remote};
|
||
|
|
|
||
|
|
$jitemid = int( $jitemid || 0 );
|
||
|
|
|
||
|
|
my $req = {
|
||
|
|
ver => 1,
|
||
|
|
username => $remote->user,
|
||
|
|
usejournal => !$remote->equals($u) ? $u->user : undef,
|
||
|
|
itemid => $jitemid,
|
||
|
|
selecttype => 'one'
|
||
|
|
};
|
||
|
|
|
||
|
|
my $err;
|
||
|
|
my $olditem = LJ::Protocol::do_request( "getevents", $req, \$err, { noauth => 1 } );
|
||
|
|
|
||
|
|
if ($err) {
|
||
|
|
my $errstr = LJ::Protocol::error_message($err);
|
||
|
|
return err
|
||
|
|
( "Unable to retrieve the item requested for editing. Protocol error: $errstr",
|
||
|
|
$r->NOT_FOUND );
|
||
|
|
}
|
||
|
|
|
||
|
|
return err ( "No entry found.", $r->NOT_FOUND )
|
||
|
|
unless scalar @{ $olditem->{events} };
|
||
|
|
|
||
|
|
my $entry_obj = LJ::Entry->new( $u, jitemid => $jitemid );
|
||
|
|
return err ( "You aren't authorize to view this entry.", $r->HTTP_UNAUTHORIZED )
|
||
|
|
unless $entry_obj && $entry_obj->visible_to($remote);
|
||
|
|
|
||
|
|
return _retrieve_entry( %$rv, item => $olditem->{events}->[0], entry_obj => $entry_obj )
|
||
|
|
if $r->method eq "GET";
|
||
|
|
return _edit_entry( %$rv, item => $olditem->{events}->[0], entry_obj => $entry_obj )
|
||
|
|
if $r->method eq "PUT";
|
||
|
|
return _delete_entry( %$rv, item => $olditem->{events}->[0], entry_obj => $entry_obj )
|
||
|
|
if $r->method eq "DELETE";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _retrieve_entry {
|
||
|
|
my (%opts) = @_;
|
||
|
|
|
||
|
|
my $u = $opts{u};
|
||
|
|
my $remote = $opts{remote};
|
||
|
|
my $olditem = $opts{item};
|
||
|
|
my $e = $opts{entry_obj};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
return ( 0, err ( "You aren't authorized to retrieve this entry.", $r->HTTP_UNAUTHORIZED ) )
|
||
|
|
unless $e->poster->equals($remote) || $remote->can_manage($u);
|
||
|
|
|
||
|
|
return ok( $e->atom_entry( apilinks => 1, synlevel => 'full' )->as_xml, );
|
||
|
|
}
|
||
|
|
|
||
|
|
# Perhaps check If-Match and If-Unmodified-Since?
|
||
|
|
sub _edit_entry {
|
||
|
|
my (%opts) = @_;
|
||
|
|
|
||
|
|
my $u = $opts{u};
|
||
|
|
my $remote = $opts{remote};
|
||
|
|
my $olditem = $opts{item};
|
||
|
|
my $entry_obj = $opts{entry_obj};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
return ( 0, err ( "You aren't authorized to edit this entry.", $r->HTTP_UNAUTHORIZED ) )
|
||
|
|
unless $entry_obj->poster->equals($remote);
|
||
|
|
|
||
|
|
return ( 0, err ( "Can't edit entry: journal is readonly.", $r->BAD_REQUEST ) )
|
||
|
|
if $u->is_readonly || $remote->is_readonly;
|
||
|
|
|
||
|
|
my ( $buff, $len, $atom_entry );
|
||
|
|
|
||
|
|
unless ($buff) {
|
||
|
|
|
||
|
|
# check length
|
||
|
|
$len = $r->header_in("Content-length");
|
||
|
|
return err ( "Content is too long", $r->HTTP_BAD_REQUEST )
|
||
|
|
if $len > $LJ::MAX_ATOM_UPLOAD;
|
||
|
|
|
||
|
|
# read the content
|
||
|
|
$r->read( $buff, $len );
|
||
|
|
}
|
||
|
|
|
||
|
|
# try parsing
|
||
|
|
eval { $atom_entry = XML::Atom::Entry->new( \$buff ); };
|
||
|
|
return err ("Could not parse the entry due to invalid markup.\n\n $@")
|
||
|
|
if $@;
|
||
|
|
|
||
|
|
# the AtomEntry must include <id> which must match the one we sent
|
||
|
|
# on GET
|
||
|
|
|
||
|
|
return err ( "Incorrect id field for entry in this request.", $r->HTTP_BAD_REQUEST )
|
||
|
|
unless $atom_entry->id eq $entry_obj->atom_id;
|
||
|
|
|
||
|
|
# remove the SvUTF8 flag. See same code in LJ::SynSuck for
|
||
|
|
# an explanation
|
||
|
|
$atom_entry->title( LJ::no_utf8_flag( $atom_entry->title ) );
|
||
|
|
$atom_entry->link( LJ::no_utf8_flag( $atom_entry->link ) );
|
||
|
|
$atom_entry->content( LJ::no_utf8_flag( $atom_entry->content->body ) )
|
||
|
|
if $atom_entry->content;
|
||
|
|
|
||
|
|
# extract the list of tags from the provided categories
|
||
|
|
my @tags = map { LJ::no_utf8_flag( $_->term ) } $atom_entry->category;
|
||
|
|
|
||
|
|
# build an edit event request. Preserve fields that aren't being
|
||
|
|
# changed by this item (perhaps the AtomEntry isn't carrying the
|
||
|
|
# complete information).
|
||
|
|
|
||
|
|
my $props = $olditem->{props};
|
||
|
|
delete $props->{revnum};
|
||
|
|
delete $props->{revtime};
|
||
|
|
$props->{taglist} = join( ", ", @tags ) if @tags;
|
||
|
|
|
||
|
|
my $req = {
|
||
|
|
ver => 1,
|
||
|
|
username => $remote->user,
|
||
|
|
usejournal => !$remote->equals($u) ? $u->user : undef,
|
||
|
|
itemid => $olditem->{itemid},
|
||
|
|
lineendings => 'unix',
|
||
|
|
subject => $atom_entry->title || $olditem->{subject},
|
||
|
|
event => $atom_entry->content->body || $olditem->{event},
|
||
|
|
props => $props,
|
||
|
|
security => $olditem->{security},
|
||
|
|
allowmask => $olditem->{allowmask},
|
||
|
|
};
|
||
|
|
|
||
|
|
my $err = undef;
|
||
|
|
my $res = LJ::Protocol::do_request( "editevent", $req, \$err, { noauth => 1 } );
|
||
|
|
if ($err) {
|
||
|
|
my $errstr = LJ::Protocol::error_message($err);
|
||
|
|
return err ( "Unable to edit entry. Protocol error: $errstr", $r->HTTP_SERVER_ERROR );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ok( "The entry was succesfully updated.", $r->OK );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _delete_entry {
|
||
|
|
|
||
|
|
# build an edit event request to delete the entry.
|
||
|
|
my (%opts) = @_;
|
||
|
|
|
||
|
|
my $u = $opts{u};
|
||
|
|
my $remote = $opts{remote};
|
||
|
|
my $olditem = $opts{item};
|
||
|
|
my $entry_obj = $opts{entry_obj};
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
|
||
|
|
return ( 0, err ( "You aren't authorized to delete this entry.", $r->HTTP_UNAUTHORIZED ) )
|
||
|
|
unless $entry_obj->poster->equals($remote) || $remote->can_manage($u);
|
||
|
|
|
||
|
|
my $req = {
|
||
|
|
usejournal => !$remote->equals($u) ? $u->user : undef,
|
||
|
|
ver => 1,
|
||
|
|
username => $remote->user,
|
||
|
|
itemid => $olditem->{itemid},
|
||
|
|
lineendings => 'unix',
|
||
|
|
event => '',
|
||
|
|
};
|
||
|
|
|
||
|
|
my $err = undef;
|
||
|
|
my $res = LJ::Protocol::do_request( "editevent", $req, \$err, { noauth => 1 } );
|
||
|
|
|
||
|
|
if ($err) {
|
||
|
|
my $errstr = LJ::Protocol::error_message($err);
|
||
|
|
return err ( "Unable to delete entry. Protocol error: $errstr", $r->HTTP_SERVER_ERROR );
|
||
|
|
}
|
||
|
|
|
||
|
|
return ok( "Entry was succesfully deleted.", $r->OK );
|
||
|
|
}
|
||
|
|
|
||
|
|
# old URL format, retaining for compatibility with old simple clients like LoudTwitter, which don't support service discovery
|
||
|
|
DW::Routing->register_string(
|
||
|
|
"/interface/atom/post", \&post_entry_compat,
|
||
|
|
app => 1,
|
||
|
|
format => "atom"
|
||
|
|
);
|
||
|
|
|
||
|
|
sub post_entry_compat {
|
||
|
|
my ($call_info) = @_;
|
||
|
|
|
||
|
|
my ( $ok, $rv ) = check_enabled();
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
( $ok, $rv ) = authenticate( allow_duplicate_nonce => 1 );
|
||
|
|
return $rv unless $ok;
|
||
|
|
|
||
|
|
my $r = DW::Request->get;
|
||
|
|
return _create_entry(%$rv) if $r->method eq "POST";
|
||
|
|
return ok("The method at this URL is deprecated. Use the service document URL, "
|
||
|
|
. $rv->{u}->atom_service_document
|
||
|
|
. ", when setting up your client." )
|
||
|
|
if $r->method eq "GET";
|
||
|
|
|
||
|
|
return err ( "URI scheme /interface/atom/entries is incompatible with " . $r->method );
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|