rt/html/REST/1.0/dhandler

   1 %# BEGIN LICENSE BLOCK
   2 %#
   3 %# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 %#
   5 %# (Except where explictly superceded by other copyright notices)
   6 %#
   7 %# This work is made available to you under the terms of Version 2 of
   8 %# the GNU General Public License. A copy of that license should have
   9 %# been provided with this software, but in any event can be snarfed
  10 %# from www.gnu.org.
  11 %#
  12 %# This work is distributed in the hope that it will be useful, but
  13 %# WITHOUT ANY WARRANTY; without even the implied warranty of
  14 %# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 %# General Public License for more details.
  16 %#
  17 %# Unless otherwise specified, all modifications, corrections or
  18 %# extensions to this work which alter its source code become the
  19 %# property of Best Practical Solutions, LLC when submitted for
  20 %# inclusion in the work.
  21 %#
  22 %#
  23 %# END LICENSE BLOCK
  24 %# REST/1.0/dhandler
  25 %#
  26 <%ARGS>
  27 @id => ()
  28 $fields => undef
  29 $format => undef
  30 $content => undef
  31 </%ARGS>
  32 <%INIT>
  33 use RT::Interface::REST;
  34
  35 my $output = "";
  36 my $status = "200 Ok";
  37 my $object = $m->dhandler_arg;
  38
  39 my $name   = qr{[\w.-]+};
  40 my $list   = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
  41 my $label  = '[a-zA-Z0-9@_.+-]+';
  42 my $field  = '[a-zA-Z][a-zA-Z0-9_-]*';
  43 my $labels = "(?:$label,)*$label";
  44
  45 # We must handle requests such as the following:
  46 #
  47 # 1. http://.../REST/1.0/show (with a list of object specifications).
  48 # 2. http://.../REST/1.0/edit (with a self-contained list of forms).
  49 # 3. http://.../REST/1.0/ticket/show (implicit type specification).
  50 #    http://.../REST/1.0/ticket/edit
  51 # 4. http://.../REST/1.0/ticket/nn (all possibly with a single form).
  52 #    http://.../REST/1.0/ticket/nn/history
  53 #    http://.../REST/1.0/ticket/nn/attachment/1
  54 #
  55 # Objects are specified by their type, and either a unique numeric ID,
  56 # or a unique name (e.g. ticket/1, queue/foo). Multiple objects of the
  57 # same type may be specified by a comma-separated list of identifiers
  58 # (e.g., user/ams,rai or ticket/1-3,5-7).
  59 #
  60 # Ultimately, we want a list of object specifications to operate upon.
  61 # The URLs in (4) provide enough information to identify an object. We
  62 # will assemble submitted information into that format in other cases.
  63 #
  64 my (@objects, $forms);
  65 my $utype;
  66
  67 if ($object eq 'show' ||                                # $REST/show
  68     (($utype) = ($object =~ m{^($name)/show$})))        # $REST/ticket/show
  69 {
  70     # We'll convert type/range specifications ("ticket/1-3,7-9/history")
  71     # into a list of singular object specifications ("ticket/1/history").
  72     # If the URL specifies a type, we'll accept only that one.
  73     foreach my $id (@id) {
  74         $id =~ s|^(?:$utype/)?|$utype/| if $utype;
  75         if (my ($type, $oids, $extra) =
  76             ($id =~ m#^($name)/($list|$labels)(?:(/.*))?$#o))
  77         {
  78             foreach my $oid (expand_list($oids)) {
  79                 if ($extra =~ m{^(?:/($name)(?:/(.*))?)?$}o) {
  80                     my ($attr, $args) = ($1, $2);
  81                     # expand transaction and attachment range specifications
  82                     # (if applicable)
  83                     my $tids;
  84                     if ($attr eq 'history' && $args =~ m#id/(\d.*)#o) {
  85                         $tids = $1;
  86                     }
  87                     if ($tids) {
  88                         push(@objects, "$type/$oid/$attr/id/$_") for expand_list($tids);
  89                     } else {
  90                         push(@objects, "$type/$oid$extra");
  91                     }
  92                 }
  93             }
  94         }
  95         else {
  96             $status = "400 Bad Request";
  97             $output = "Invalid object ID specified: '$id'";
  98             goto OUTPUT;
  99         }
 100     }
 101 }
 102 elsif ($object eq 'edit' ||                             # $REST/edit
 103     (($utype) = ($object =~ m{^($name)/edit$})))        # $REST/ticket/edit
 104 {
 105     # We'll make sure each of the submitted forms is syntactically valid
 106     # and sufficiently identifies an object to operate upon, then add to
 107     # the object list as above.
 108     my @output;
 109
 110     $forms = form_parse($content);
 111     foreach my $form (@$forms) {
 112         my ($c, $o, $k, $e) = @$form;
 113
 114         if ($e) {
 115             push @output, [ "# Syntax error.", $o, $k, $e ];
 116         }
 117         else {
 118             my ($type, $id);
 119
 120             # Look for matching types in the ID, form, and URL.
 121             $type = exists $k->{type} ? $k->{type} : $utype;
 122             $type =~ s|^(?:$utype)?|$utype/| if $utype;
 123             $type =~ s|/$||;
 124
 125             if (exists $k->{id}) {
 126                 $id = $k->{id};
 127                 $id =~ s|^(?:$type/)?|$type/| if $type;
 128
 129                 if ($id =~ m#^$name/(?:$label|\d+)(?:/.*)?#o) {
 130                     push @objects, $id;
 131                 }
 132                 else {
 133                     push @output, [ "# Invalid object ID: '$id'", $o, $k, $e ];
 134                 }
 135             }
 136             else {
 137                 push @output, [ "# No object ID specified.", $o, $k, $e ];
 138             }
 139         }
 140     }
 141     # If we saw any errors at this stage, we won't process any part of
 142     # the submitted data.
 143     if (@output) {
 144         unshift @output, [ "# Please resubmit with errors corrected." ];
 145         $status = "409 Syntax Error";
 146         $output = form_compose(\@output);
 147         goto OUTPUT;
 148     }
 149 }
 150 else {
 151     # We'll assume that this is in the correct format already. Otherwise
 152     # it will be caught by the loop below.
 153     push @objects, $object;
 154
 155     if ($content) {
 156         $forms = form_parse($content);
 157
 158         if (@$forms > 1) {
 159             $status = "400 Bad Request";
 160             $output = "You may submit only one form to this object.";
 161             goto OUTPUT;
 162         }
 163
 164         my ($c, $o, $k, $e) = @{ $forms->[0] };
 165         if ($e) {
 166             $status = "409 Syntax Error";
 167             $output = form_compose([ ["# Syntax error.", $o, $k, $e] ]);
 168             goto OUTPUT;
 169         }
 170     }
 171 }
 172
 173 # Make sure we have something to do.
 174 unless (@objects) {
 175     $status = "400 Bad Request";
 176     $output = "No objects specified.";
 177     goto OUTPUT;
 178 }
 179
 180 # Parse and validate any field specifications.
 181 my (%fields, @fields);
 182 if ($fields) {
 183     unless ($fields =~ /^(?:$field,)*$field$/) {
 184         $status = "400 Bad Request";
 185         $output = "Invalid field specification: $fields";
 186         goto OUTPUT;
 187     }
 188     @fields = map lc, split /,/, $fields;
 189     @fields{@fields} = ();
 190     unless (exists $fields{id}) {
 191         unshift @fields, "id";
 192         $fields{id} = ();
 193     }
 194 }
 195
 196 my (@comments, @output);
 197
 198 foreach $object (@objects) {
 199     my ($handler, $type, $id, $attr, $args);
 200     my ($c, $o, $k, $e) = ("", ["id"], {id => $object}, 0);
 201
 202     my $i = 0;
 203     if ($object =~ m{^($name)/(\d+|$label)(?:/($name)(?:/(.*))?)?$}o ||
 204         $object =~ m{^($name)/(new)$}o)
 205     {
 206         ($type, $id, $attr, $args) = ($1, $2, ($3 || 'default'), $4);
 207         $handler = "Forms/$type/$attr";
 208
 209         unless ($m->comp_exists($handler)) {
 210             $args = "$attr/$args";
 211             $handler = "Forms/$type/default";
 212
 213             unless ($m->comp_exists($handler)) {
 214                 $i = 2;
 215                 $c = "# Unknown object type: $type";
 216             }
 217         }
 218         elsif ($id ne 'new' && $id !~ /^\d+$/) {
 219             my $ns = "Forms/$type/ns";
 220
 221             # Can we resolve named objects?
 222             unless ($m->comp_exists($ns)) {
 223                 $i = 3;
 224                 $c = "# Objects of type $type must be specified by numeric id.";
 225             }
 226             else {
 227                 my ($n, $s) = $m->comp("Forms/$type/ns", id => $id);
 228                 if ($n <= 0) { $i = 4; $c = "# $s"; }
 229                 else         { $i = 0; $id = $n;    }
 230             }
 231         }
 232         else {
 233             $i = 0;
 234         }
 235     }
 236     else {
 237         $i = 1;
 238         $c = "# Invalid object specification: '$object'";
 239     }
 240
 241     if ($i != 0) {
 242         if ($content) {
 243             (undef, $o, $k, $e) = @{ shift @$forms };
 244         }
 245         push @output, [ $c, $o, $k ];
 246         next;
 247     }
 248
 249     unless ($content) {
 250         my $d = $m->comp($handler, id => $id, args => $args, format => $format, fields => \%fields);
 251         my ($c, $o, $k, $e) = @$d;
 252
 253         if (!$e && @$o && keys %fields) {
 254             my %lk = map { lc $_ => $_ } keys %$k;
 255             @$o = map { $lk{$_} } @fields;
 256             foreach my $key (keys %$k) {
 257                 delete $k->{$key} unless exists $fields{lc $key};
 258             }
 259         }
 260         push(@output, [ $c, $o, $k ]) if ($c || @$o || keys %$k);
 261     }
 262     else {
 263         my ($c, $o, $k, $e) = @{ shift @$forms };
 264         my $d = $m->comp($handler, id => $id, args => $args, format => $format,
 265                          changes => $k);
 266         ($c, $o, $k, $e) = @$d;
 267
 268         # We won't pass $e through to compose, trusting instead that the
 269         # handler added suitable comments for the user.
 270         if ($e) {
 271             $status = "409 Syntax Error" if @$o;
 272             push @output, [ $c, $o, $k ];
 273         }
 274         else {
 275             push @comments, $c;
 276         }
 277     }
 278 }
 279
 280 unshift(@output, [ join "\n", @comments ]) if @comments;
 281 $output = form_compose(\@output);
 282
 283 OUTPUT:
 284 </%INIT>
 285 RT/<% $RT::VERSION %> <% $status %>
 286
 287 <% $output |n %>