1 %# BEGIN BPS TAGGED BLOCK {{{
5 %# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
6 %# <sales@bestpractical.com>
8 %# (Except where explicitly superseded by other copyright notices)
13 %# This work is made available to you under the terms of Version 2 of
14 %# the GNU General Public License. A copy of that license should have
15 %# been provided with this software, but in any event can be snarfed
18 %# This work is distributed in the hope that it will be useful, but
19 %# WITHOUT ANY WARRANTY; without even the implied warranty of
20 %# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 %# General Public License for more details.
23 %# You should have received a copy of the GNU General Public License
24 %# along with this program; if not, write to the Free Software
25 %# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 %# 02110-1301 or visit their web page on the internet at
27 %# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 %# CONTRIBUTION SUBMISSION POLICY:
32 %# (The following paragraph is not intended to limit the rights granted
33 %# to you to modify and distribute this software under the terms of
34 %# the GNU General Public License and is only of importance to you if
35 %# you choose to contribute your changes and enhancements to the
36 %# community by submitting them to Best Practical Solutions, LLC.)
38 %# By intentionally submitting any modifications, corrections or
39 %# derivatives to this work, or any other work intended for use with
40 %# Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 %# you are the copyright holder for those contributions and you grant
42 %# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 %# royalty-free, perpetual, license to use, copy, create derivative
44 %# works based on those contributions, and sublicense and distribute
45 %# those contributions and any derivatives thereof.
47 %# END BPS TAGGED BLOCK }}}
57 use RT::Interface::REST;
60 my $status = "200 Ok";
61 my $object = $m->dhandler_arg;
63 my $name = qr{[\w.-]+};
64 my $list = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
65 my $label = '[^,\\/]+';
66 my $field = RT::Interface::REST->field_spec;
67 my $labels = "(?:$label,)*$label";
69 # We must handle requests such as the following:
71 # 1. http://.../REST/1.0/show (with a list of object specifications).
72 # 2. http://.../REST/1.0/edit (with a self-contained list of forms).
73 # 3. http://.../REST/1.0/ticket/show (implicit type specification).
74 # http://.../REST/1.0/ticket/edit
75 # 4. http://.../REST/1.0/ticket/nn (all possibly with a single form).
76 # http://.../REST/1.0/ticket/nn/history
77 # http://.../REST/1.0/ticket/nn/comment
78 # http://.../REST/1.0/ticket/nn/attachment/1
80 # Objects are specified by their type, and either a unique numeric ID,
81 # or a unique name (e.g. ticket/1, queue/foo). Multiple objects of the
82 # same type may be specified by a comma-separated list of identifiers
83 # (e.g., user/ams,rai or ticket/1-3,5-7).
85 # Ultimately, we want a list of object specifications to operate upon.
86 # The URLs in (4) provide enough information to identify an object. We
87 # will assemble submitted information into that format in other cases.
89 my (@objects, $forms);
92 if ($object eq 'show' || # $REST/show
93 (($utype) = ($object =~ m{^($name)/show$}))) # $REST/ticket/show
95 # We'll convert type/range specifications ("ticket/1-3,7-9/history")
96 # into a list of singular object specifications ("ticket/1/history").
97 # If the URL specifies a type, we'll accept only that one.
98 foreach my $id (@id) {
99 $id =~ s|^(?:$utype/)?|$utype/| if $utype;
100 if (my ($type, $oids, $extra) =
101 ($id =~ m#^($name)/($list|$labels)(?:(/.*))?$#o))
104 my ($attr, $args) = $extra =~ m{^(?:/($name)(?:/(.*))?)?$}o;
106 if ($attr and $attr eq 'history' and $args) {
107 ($tids) = $args =~ m#id/(\d.*)#o;
109 # expand transaction and attachment range specifications
111 foreach my $oid (expand_list($oids)) {
113 push(@objects, "$type/$oid/$attr/id/$_") for expand_list($tids);
115 push(@objects, "$type/$oid$extra");
120 $status = "400 Bad Request";
121 $output = "Invalid object ID specified: '$id'";
126 elsif ($object eq 'edit' || # $REST/edit
127 (($utype) = ($object =~ m{^($name)/edit$}))) # $REST/ticket/edit
129 # We'll make sure each of the submitted forms is syntactically valid
130 # and sufficiently identifies an object to operate upon, then add to
131 # the object list as above.
134 $forms = form_parse($content);
135 foreach my $form (@$forms) {
136 my ($c, $o, $k, $e) = @$form;
139 push @output, [ "# Syntax error.", $o, $k, $e ];
144 # Look for matching types in the ID, form, and URL.
145 $type = $utype || $k->{id};
146 $type =~ s|^([^/]+)/\d+$|$1| if !$utype;
147 $type =~ s|^(?:$utype)?|$utype/| if $utype;
148 $type =~ s|/$|| if $type;
150 if (exists $k->{id}) {
152 $id =~ s|^(?:$type/)?|$type/| if $type;
154 if ($id =~ m#^$name/(?:$label|\d+)(?:/.*)?#o) {
158 push @output, [ "# Invalid object ID: '$id'", $o, $k, $e ];
162 push @output, [ "# No object ID specified.", $o, $k, $e ];
166 # If we saw any errors at this stage, we won't process any part of
167 # the submitted data.
169 unshift @output, [ "# Please resubmit with errors corrected." ];
170 $status = "409 Syntax Error";
171 $output = form_compose(\@output);
176 # We'll assume that this is in the correct format already. Otherwise
177 # it will be caught by the loop below.
178 push @objects, $object;
181 $forms = form_parse($content);
184 $status = "400 Bad Request";
185 $output = "You may submit only one form to this object.";
189 my ($c, $o, $k, $e) = @{ $forms->[0] };
191 $status = "409 Syntax Error";
192 $output = form_compose([ ["# Syntax error.", $o, $k, $e] ]);
198 # Make sure we have something to do.
200 $status = "400 Bad Request";
201 $output = "No objects specified.";
205 # Parse and validate any field specifications.
206 my (%fields, @fields);
208 unless ($fields =~ /^(?:$field,)*$field$/) {
209 $status = "400 Bad Request";
210 $output = "Invalid field specification: $fields";
213 @fields = map lc, split /\s*,\s*/, $fields;
214 @fields{@fields} = ();
215 unless (exists $fields{id}) {
216 unshift @fields, "id";
220 # canonicalize cf-foo to cf.{foo}
221 for my $field (@fields) {
222 if ($field =~ /^(c(?:ustom)?f(?:ield)?)-(.+)/) {
223 $fields{"cf.{$2}"} = delete $fields{"$1-$2"};
225 # overwrite the element in @fields
231 my (@comments, @output);
233 foreach $object (@objects) {
234 my ($handler, $type, $id, $attr, $args);
235 my ($c, $o, $k, $e) = ("", ["id"], {id => $object}, 0);
238 if ($object =~ m{^($name)/(\d+|$label)(?:/($name)(?:/(.*))?)?$}o ||
239 $object =~ m{^($name)/(new)$}o)
241 ($type, $id, $attr, $args) = ($1, $2, ($3 || 'default'), $4);
242 $handler = "Forms/$type/$attr";
244 unless ($m->comp_exists($handler)) {
245 $args = defined $args ? "$attr/$args" : $attr;
246 $handler = "Forms/$type/default";
248 unless ($m->comp_exists($handler)) {
250 $c = "# Unknown object type: $type";
253 elsif ($id ne 'new' && $id !~ /^\d+$/) {
254 my $ns = "Forms/$type/ns";
256 # Can we resolve named objects?
257 unless ($m->comp_exists($ns)) {
259 $c = "# Objects of type $type must be specified by numeric id.";
262 my ($n, $s) = $m->comp("Forms/$type/ns", id => $id);
263 if ($n <= 0) { $i = 4; $c = "# $s"; }
264 else { $i = 0; $id = $n; }
273 $c = "# Invalid object specification: '$object'";
278 (undef, $o, $k, $e) = @{ shift @$forms };
280 push @output, [ $c, $o, $k ];
285 my $d = $m->comp($handler, id => $id, args => $args, format => $format, fields => \%fields);
286 my ($c, $o, $k, $e) = @$d;
288 if (!$e && @$o && keys %fields) {
289 my %lk = map { lc $_ => $_ } keys %$k;
290 @$o = map { $lk{$_} } @fields;
291 foreach my $key (keys %$k) {
292 delete $k->{$key} unless exists $fields{lc $key};
295 push(@output, [ $c, $o, $k ]) if ($c || @$o || keys %$k);
298 my ($c, $o, $k, $e) = @{ shift @$forms };
299 my $d = $m->comp($handler, id => $id, args => $args, format => $format,
301 ($c, $o, $k, $e) = @$d;
303 # We won't pass $e through to compose, trusting instead that the
304 # handler added suitable comments for the user.
307 $status = "409 Syntax Error";
310 $status = "400 Bad Request";
312 push @output, [ $c, $o, $k ];
320 unshift(@output, [ join "\n", @comments ]) if @comments;
321 $output = form_compose(\@output);
324 $m->out("RT/".$RT::VERSION ." ".$status ."\n\n$output\n") if ($output || $status !~ /^200/);