###################################################################### # # EPrints::Apache::CRUD # ###################################################################### # # ###################################################################### =pod =for Pod2Wiki {{Version|since=3.3.0}} =head1 NAME B - Create, read, update and delete via HTTP =head1 SYNOPSIS $crud = EPrints::Apache::CRUD->new( repository => $repo, request => $r, datasetid => "eprint", dataobjid => "23", ); =head1 DESCRIPTION The CRUD (Create/Read/Update/Delete) module provides the Web API for manipulating content on the server. The API is an AtomPub implementation that exposes Import and Export plugins via simple URLs and HTTP content type negotiation. You should use the entries in the repository's home page to locate the CRUD endpoint, as they may change in the future: =head2 Examples Create a new eprint based on a single file: curl -X POST \ -i \ -u user:password \ -d 'Hello, World!' \ -H 'Content-Type: text/plain' \ https://myrepo/id/contents HTTP/1.1 201 Created Content-Type: application/atom+xml;charset=utf-8 ... Add a file to an existing eprint: curl -X POST \ -i \ -u user:password \ -d 'Hello, World!' \ -H 'Content-Disposition: attachment; filename=hello.txt' \ -H 'Content-Type: text/plain' \ https://myrepo/id/eprint/23/contents HTTP/1.1 201 Created Content-Type: application/atom+xml;charset=utf-8 ... Get an eprint's metadata in Atom XML: curl -X GET \ -i \ -u user:password \ -H 'Accept: application/atom+xml' \ https://myrepo/id/eprint/23 HTTP/1.1 200 OK Content-Type: application/atom+xml;charset=utf-8 ... Get the list of contents (documents) of an eprint in Atom XML: curl -X GET \ -i \ -u user:password \ -H 'Accept: application/atom+xml' \ https://myrepo/id/eprint/23/contents HTTP/1.1 200 OK Content-Type: application/atom+xml;charset=utf-8 ... You can find more examples in the F unit test. =head2 URI Layout These URIs are relative to your EPrints HTTP/HTTPs root. =over 4 =item /id/contents GET,HEAD,OPTIONS,POST Requires authentication. C a list of the eprints owned by the user. C to create a new EPrint object. =item /id/[datasetid]/[dataobjid] DELETE,GET,HEAD,OPTIONS,PUT Requires authentication depending on user's privileges and object visibility. C an object's metadata or, for L objects, the file content. C to replace the metadata and/or contents (see L). If the object does not exist will attempt to create it with the given dataobjid (requires C privilege). =item /id/[datasetid]/[dataobjid]/contents DELETE,GET,HEAD,OPTIONS,POST,PUT Requires authentication depending on user's privileges and object visibility. C the logical contents of the object: documents for eprints or files for documents. C to replace the existing contents or POST to add to the existing contents. =back =head2 HTTP Content Negotiation C/C requests are processed using L plugins. C/C requests are processed using L plugins. The plugin used depends on the request's C (C/C) or C (C/C) header and the type of object being acted on. For example, the following request: GET /id/eprint/23 HTTP/1.1 Accept: application/vnd.eprints.data+xml Will search for an Export plugin that accepts objects of type C and can produce output in the MIME type C. This will most likely be the L plugin. In addition to the general plugin negotiation behaviour some special cases are supported to improve compatibility with Atom Pub/Web Browser clients: =over 4 =item /id/eprint/... Requesting L objects as text/html will result in a C<303 Redirect> to the eprint object's abstract page or, if the eprint is not public, its L page. =item /id/document/.../contents Requesting the C of a L object will return the content of the document's main file. =item /id/file/... Requesting a L object with no C header (or C<*/*>) will return the file's content. =item POST /id/.../contents When creating new records via POST, content negotiation is performed against the Import plugins. If no Import plugin supports the I header the content will be treated as C and stored in a new object. The resulting Atom entry will describe the new object (e.g. the C object in which the new C and C objects were created). Otherwise, the result will depend on the Import plugin's output. Import plugins may produce a single object, multiple objects or an object plus content file(s). =item Content-Type header If no C header is given the MIME type defaults to C for Cs and Cs. =item Content-Disposition header If the C header is missing or does not contain a C parameter the filename defaults to F for Cs and Cs. =back =head2 Updating complex objects using PUT Eprint objects contain zero or more documents, which each contain zero or more files. When you update (C) an eprint object the contained documents will only be replaced if the Import plugin defines new documents e.g. the Atom Import plugin will never define new documents so Cing Atom content will only update the eprint's metadata. Cing L will replace the documents if you include a C<> XML element. Cing to C will always replace all contents - Cing to C is equivalent to C then C. =head2 PUT/DELETE from Javascript =for MediaWiki {{Available|since=3.3.9}} Web browsers only allow C and C requests. To perform other requests use the C header with C to specify the actual method you want: POST /id/eprint/23 HTTP/1.1 X-Method: PUT ... =head2 Upserting objects with PUT =for MediaWiki {{Available|since=3.3.9}} If you have the C privilege objects will be created on demand, otherwise attempting to C to a non-existent object will result in an error. =cut package EPrints::Apache::CRUD; use EPrints::Const qw( :http ); use MIME::Base64; use HTTP::Headers::Util; use Digest::MD5; use EPrints::Apache::Auth; use Apache2::Access; our $PACKAGING_PREFIX = "sword:"; =pod =head1 CONSTANTS =over 4 =item CRUD_SCOPE_USER_CONTENTS Restrict the scope of the CRUD request to user submitting content (i.e. F). =item CRUD_SCOPE_DATASET Restrict the scope of the CRUD request to a dataset (i.e. F). =item CRUD_SCOPE_DATAOBJ Restrict the scope of the CRUD request to a data object (i.e. F). =item CRUD_SCOPE_FIELD Restrict the scope of the CRUD request to a field of data object (i.e. F). =item CRUD_SCOPE_CONTENTS Restrict the scope of the CRUD request to the contents of data object (i.e. F). =item CRUD_SCOPE_SERVICEDOCUMENT Restrict the scope of the CRUD request to the service document. =back =head1 METHODS =cut use constant { CRUD_SCOPE_USER_CONTENTS => 1, CRUD_SCOPE_DATASET => 2, CRUD_SCOPE_DATAOBJ => 3, CRUD_SCOPE_FIELD => 4, CRUD_SCOPE_CONTENTS => 5, CRUD_SCOPE_SERVICEDOCUMENT => 6, }; use strict; my %CONTENTSMAP = ( "EPrints::DataObj::EPrint" => "documents", "EPrints::DataObj::Document" => "files", ); ###################################################################### =pod =head2 Constructor Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $crud = EPrints::Apache::CRUD->new( %params ) Return a new CRUD request using parameters given in C<%params>. =cut ###################################################################### sub new { my( $class, %self ) = @_; my $self = bless \%self, $class; my $rc = $self->process_headers; $self->request->status( $rc ), return if $rc != OK; $self{options} = [qw( GET HEAD OPTIONS )]; # servicedocument FIXME return $self if !exists $self{datasetid}; my $repo = $self{repository}; # /id/FOO... if( defined $self{datasetid} ) { $self{dataset} = $repo->dataset( $self{datasetid} ); if( !defined $self{dataset} ) { $self{request}->status( HTTP_NOT_FOUND ); return; } $self{options} = [qw( GET HEAD POST OPTIONS )]; $self{scope} = CRUD_SCOPE_DATASET; } # /id/contents else { $self{dataset} = $repo->dataset( "eprint" ); $self{options} = [qw( GET HEAD POST OPTIONS )]; $self{scope} = CRUD_SCOPE_USER_CONTENTS; } # /id/FOO/BAR if( defined $self{dataobjid} ) { my @relations; if( $self{dataset}->base_id eq "document" ) { ($self{dataobjid}, @relations) = split /\./, $self{dataobjid}; @relations = grep { length($_) } @relations; } $self{dataobj} = $self{dataset}->dataobj( $self{dataobjid} ); # resolve 11.hassmallThumbnailVersion $self{dataobj} = $self->resolve_relations( $self{dataobj}, @relations ); # adjust /id/eprint/23 to /id/archive/23 $self{dataset} = $self{dataobj}->get_dataset if defined $self{dataobj}; $self{options} = [qw( GET HEAD PUT PATCH OPTIONS )]; $self{scope} = CRUD_SCOPE_DATAOBJ; } # /id/FOO/BAR/BAZ if( defined $self{fieldid} ) { if( $self{fieldid} eq "contents" ) { $self{options} = [qw( GET HEAD POST PUT OPTIONS )]; $self{scope} = CRUD_SCOPE_CONTENTS; my $fieldid = $CONTENTSMAP{ref($self->dataobj)}; if( !defined $fieldid ) { $self{request}->status( HTTP_NOT_FOUND ); return; } $self{field} = $self{dataset}->field( $fieldid ); $self{dataset} = $repo->dataset( $self{field}->property( "datasetid" ) ); } elsif( !$self{dataset}->has_field( $self{fieldid} ) ) { $self{request}->status( HTTP_NOT_FOUND ); return; } else { $self{field} = $self{dataset}->field( $self{fieldid} ); $self{options} = [qw( GET HEAD PUT OPTIONS )]; $self{scope} = CRUD_SCOPE_FIELD; } } if( !defined $self{plugin} ) { $self{plugin} = $self->content_negotiate_best_plugin; } return $self; } ###################################################################### =pod =back =head2 Class Methods =cut ###################################################################### ###################################################################### =pod =item $error_document = EPrints::Apache::CRUD::generate_error_document( $repo, %opts ) Return error document for L C<$repo> using options from C<%opts>. =cut ###################################################################### sub generate_error_document { my ( $repo, %opts ) = @_; my $xml = $repo->xml; $opts{href} = "http://eprints.org/sword/error/UnknownError" if !defined $opts{href}; my $error = $xml->create_data_element( "sword:error", [ [ "title", "ERROR" ], [ "updated", EPrints::Time::get_iso_timestamp() ], [ "generator", $repo->phrase( "archive_name" ), uri => "http://www.eprints.org/", version => EPrints->human_version, ], [ "summary", $opts{summary} ], [ "sword:userAgent", $opts{user_agent} ], ], "xmlns" => "http://www.w3.org/2005/Atom", "xmlns:sword" => "http://purl.org/net/sword/", href => $opts{href}, ); return "\n" . $xml->to_string( $error, indent => 1 ); } ###################################################################### =pod =item $boolean = EPrints::Apache::CRUD::is_true( $header ) Tests if C<$header> attribute is C. =cut ###################################################################### sub is_true { return defined($_[0]) && lc($_[0]) eq "true"; } ###################################################################### =pod =item $boolean = EPrints::Apache::CRUD::is_false( $header ) Tests if C<$header> attribute is C. =cut ###################################################################### sub is_false { return defined($_[0]) && lc($_[0]) eq "false"; } ###################################################################### =pod =back =head2 Object Methods =cut ###################################################################### ###################################################################### =pod =over 4 =item $repo = $crud->repository() Returns the current repository. =cut ###################################################################### sub repository { $_[0]->{repository} } ###################################################################### =pod =item $r = $crud->request() Returns the current L. =cut ###################################################################### sub request { $_[0]->{request} } ###################################################################### =pod =item $method = $crud->method() Returns the HTTP method. =cut ###################################################################### sub method { $_[0]->{method} } ###################################################################### =pod =item $scope = $crud->scope() Returns the scope of the action being performed. =cut ###################################################################### sub scope { $_[0]->{scope} } ###################################################################### =pod =item $dataset = $crud->dataset() Returns the current dataset (if any). =cut ###################################################################### sub dataset { $_[0]->{dataset} } ###################################################################### =pod =item $dataobj = $crud->dataobj() Returns the current dataobj (if any). =cut ###################################################################### sub dataobj { $_[0]->{dataobj} } ###################################################################### =pod =item $field = $crud->field() Returns the current field (if available); =cut ###################################################################### sub field { $_[0]->{field} } ###################################################################### =pod =item $headers = $crud->headers() Get the processed headers. =cut ###################################################################### sub headers { $_[0]->{headers} } ###################################################################### =pod =item @verbs = $crud->options() Returns the available HTTP verbs for the current request. =cut ###################################################################### sub options { @{$_[0]->{options}} } ###################################################################### =pod =item $plugin = $crud->plugin() Returns the current plugin (if available). =cut ###################################################################### sub plugin { $_[0]->{plugin} } ###################################################################### =pod =item $bool = $crud->is_write() Returns C if the request is not a read-only method. =cut ###################################################################### sub is_write { $_[0]->method !~ /^GET|HEAD|OPTIONS$/ } ###################################################################### =pod =item $accept_type = $crud->accept_type() Returns the EPrints type for the current request. =cut ###################################################################### sub accept_type { my( $self ) = @_; my $accept_type = $self->dataset->base_id; if( $self->is_write || $self->scope == CRUD_SCOPE_DATAOBJ || $self->scope == CRUD_SCOPE_SERVICEDOCUMENT ) { $accept_type = "dataobj/".$accept_type; } else { $accept_type = "list/".$accept_type; } return $accept_type; } ###################################################################### =pod =item $rc = $crud->check_packaging() Check the Packaging header is ok, if given. =cut ###################################################################### sub check_packaging { my( $self ) = @_; my $headers = $self->headers; if( $headers->{packaging} && !defined $self->plugin ) { return $self->sword_error( status => HTTP_BAD_REQUEST, href => "http://purl.org/net/sword/error/ErrorContent", summary => "No support for packaging '$headers->{packaging}'", ); } return OK; } ###################################################################### =pod =item $dataobj = $crud->resolve_relations( $dataobj [, @relations ] ) Resolve the relation path from C<$dataobj> and return the resulting data object. Returns c if there is no such related object. =cut ###################################################################### sub resolve_relations { my( $self, $dataobj, @relations ) = @_; foreach my $r (@relations) { last if !defined $dataobj; $r =~ s/^has(.+)$/is$1Of/; $dataobj = $dataobj->search_related( $r )->item( 0 ); } return $dataobj; } sub _priv { my( $self ) = @_; my $r = $self->request; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $plugin = $self->plugin; my $field = $self->field; my $priv; # /id/xx/yy/contents if( $self->scope eq CRUD_SCOPE_CONTENTS ) { $priv = $self->is_write ? "edit" : "view"; $dataobj = $dataobj->parent if $dataobj->isa( "EPrints::DataObj::File" ); $dataobj = $dataobj->parent if $dataobj->isa( "EPrints::DataObj::Document" ); $dataset = $dataobj->get_dataset; } elsif( $self->method eq "POST" ) { $priv = "create"; } elsif( $self->method eq "PUT" ) { if( $self->scope == CRUD_SCOPE_DATAOBJ && !defined $dataobj ) { $priv = "upsert"; } else { $priv = "edit"; } } elsif( $self->method eq "PATCH" ) { $priv = "edit"; } elsif( $self->method eq "DELETE" ) { $priv = "destroy"; } elsif( defined($plugin) && $plugin->get_subtype ne "SummaryPage" ) { $priv = "export"; } else { $priv = "view"; } if( $dataset->base_id eq "eprint" && $priv eq "create" ) { $priv = "create_eprint"; } elsif( $self->scope eq CRUD_SCOPE_USER_CONTENTS && $dataset->base_id eq "eprint" && $priv eq "view" ) { $priv = "items"; } elsif( $dataset->id ne $dataset->base_id ) { return( join('/', $dataset->base_id, $dataset->id, $priv ), join('/', $dataset->base_id, $priv ), ); } else { $priv = join('/', $dataset->base_id, $priv ); } return $priv; } ###################################################################### =pod =item $rc = $crud->authen Returns HTTP code based of whether CRUD request can be authenticated. =cut ###################################################################### sub authen { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $plugin = $self->plugin; # POST, PUT, DELETE must authenticate if( $self->is_write ) { return EPrints::Apache::Auth::authen( $r ); } # a staff-plugin implicitly requires a user if( defined($plugin) && $plugin->param( "visible" ) eq "staff" ) { return EPrints::Apache::Auth::authen( $r ); } # /id/contents implicitly requires a user if( $self->scope eq CRUD_SCOPE_USER_CONTENTS ) { return EPrints::Apache::Auth::authen( $r ); } my @privs = $self->_priv; if( defined $dataobj ) { foreach my $priv (@privs) { return OK if $dataobj->permit( $priv ); } } else { foreach my $priv (@privs) { return OK if $repo->allow_anybody( $priv ); } } return EPrints::Apache::Auth::authen( $r ); } ###################################################################### =pod =item $rc = $crud->authz Returns HTTP code based of whether CRUD request can be authorized. =cut ###################################################################### sub authz { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $plugin = $self->plugin; my $user = $repo->current_user; if( defined($plugin) && $plugin->param( "visible" ) eq "staff" ) { return HTTP_FORBIDDEN if !defined $user || !$user->is_staff; } my @privs = $self->_priv; if( defined $dataobj ) { foreach my $priv (@privs) { return OK if $dataobj->permit( $priv, $user ); } } elsif ( defined $self->{dataobjid} && $self->{method} ne "PUT" ) # Data object may not already exist if using PUT for upsert { return HTTP_NOT_FOUND; } elsif( defined $user ) { foreach my $priv (@privs) { return OK if $user->allow( $priv ); } } else { foreach my $priv (@privs) { return OK if $repo->allow_anybody( $priv ); } } return HTTP_FORBIDDEN; } sub _read_content { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $headers = $self->headers; my $ctx = $headers->{content_md5} ? Digest::MD5->new : undef; my $tmpfile = File::Temp->new( SUFFIX => $headers->{extension} ); binmode($tmpfile); my $len = 0; while($r->read(my $buffer, 4096)) { $len += length($buffer); $ctx->add( $buffer ) if defined $ctx; print $tmpfile $buffer; } seek($tmpfile,0,0); if( defined $ctx && $ctx->hexdigest ne $headers->{content_md5} ) { $self->sword_error( status => HTTP_PRECONDITION_FAILED, href => "http://purl.org/net/sword/error/ErrorChecksumMismatch", summary => "MD5 digest mismatch between headers and content", ); return undef; } return $tmpfile; } ###################################################################### =pod =item $list = $crud->parse_input( $plugin, $f [, %params ] ) Parse the content submitted by the user using the given C<$plugin>. C<$f> is called by c to convert EPrints data markup to a data object. C<%params> are passed to the plugin's C method. Returns C on error. Otherwise returns an L of data objects. =cut ###################################################################### sub parse_input { my( $self, $plugin, $f, %params ) = @_; my $repo = $self->repository; my $headers = $self->headers; my @messages; my $count = 0; $plugin->set_handler( EPrints::CLIProcessor->new( message => sub { push @messages, $_[1] }, epdata_to_dataobj => sub { ++$count; &$f }, ) ); my $tmpfile = $self->_read_content(); return undef if !defined $tmpfile; my %content_type_params; for(keys %{$headers->{content_type_params}}) { next if !$plugin->has_argument( $_ ); $content_type_params{$_} = $headers->{content_type_params}->{$_}; } my $list = eval { $plugin->input_fh( %content_type_params, dataset => $self->dataset, fh => $tmpfile, filename => $headers->{filename}, mime_type => $headers->{mime_type}, content_type => $headers->{content_type}, actions => $headers->{actions}, %params, ) }; if( !defined $list ) { $self->plugin_error( $plugin, \@messages ); return undef; } elsif( $count == 0 ) { $plugin->handler->message( "error", "Import plugin didn't create anything" ); $self->plugin_error( $plugin, \@messages ); return undef; } return $list; } ###################################################################### =pod =item $dataobj = $crud->create_dataobj( $owner, $epdata ) Creates data object as user $owner with metadata from $epdata Returns an L. =cut ###################################################################### sub create_dataobj { my( $self, $owner, $epdata ) = @_; $epdata = {} if !defined $epdata; my $repo = $self->repository; my $dataset = $self->dataset; local $repo->{config}->{enable_import_fields} = 1; $epdata->{$dataset->key_field->name} = $self->{dataobjid}; if( $dataset->base_id eq "eprint" ) { $epdata->{userid} = $owner->id; $epdata->{eprint_status} = "inbox"; } return $dataset->create_dataobj( $epdata ); } ###################################################################### =pod =item @plugins = $crud->import_plugins( [ %params ] ) Returns all matching import plugins against C<%params> ordered by descending C score. =cut ###################################################################### sub import_plugins { my( $self, %params ) = @_; my $user = $self->repository->current_user; if( defined $user && !$user->is_staff ) { $params{is_visible} = "all"; } my @plugins = $self->repository->get_plugins( type => "Import", can_produce => $self->accept_type, %params, ); my %qs = map { $_ => ($_->param( "qs" ) || 0) } @plugins; my %ids = map { $_ => $_->get_id } @plugins; return sort { $qs{$b} <=> $qs{$a} || $ids{$a} cmp $ids{$b} } @plugins; } ###################################################################### =pod =item @plugins = $crud->export_plugins( [ %params ] ) Returns all matching export plugins against C<%params> ordered by descending C score. =cut ###################################################################### sub export_plugins { my( $self, %params ) = @_; my $user = $self->repository->current_user; if( defined $user && !$user->is_staff ) { $params{is_visible} = "all"; } my @plugins = $self->repository->get_plugins( type => "Export", can_accept => $self->accept_type, %params, ); my %qs = map { $_ => ($_->param( "qs" ) || 0) } @plugins; my %ids = map { $_ => $_->get_id } @plugins; return sort { $qs{$b} <=> $qs{$a} || $ids{$a} cmp $ids{$b} } @plugins; } ###################################################################### =pod =item $plugin = $crud->content_negotiate_best_plugin() Work out the best plugin to export/update an object based on the client headers. =cut ###################################################################### sub content_negotiate_best_plugin { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $field = $self->field; my $headers = $self->headers; return undef if $self->method eq "DELETE"; my $accept_type = $self->accept_type; if( defined(my $package = $headers->{packaging}) ) { my $plugin; if( $self->is_write ) { ($plugin) = $self->import_plugins( can_accept => $PACKAGING_PREFIX.$package, can_action => $headers->{actions}, ); } else { ($plugin) = $self->export_plugins( can_produce => $PACKAGING_PREFIX.$package, ); } return $plugin; } my @plugins; if( $self->is_write ) { @plugins = $self->import_plugins( can_action => $headers->{actions}, ); } else { @plugins = $self->export_plugins(); } my %pset; foreach my $plugin ( @plugins ) { my $mimetype = $plugin->get_type eq "Export" ? $plugin->param( "produce" ) : $plugin->param( "accept" ); $mimetype = join ',', @$mimetype; for( HTTP::Headers::Util::split_header_words( $mimetype ) ) { my( $type, undef, %params ) = @$_; push @{$pset{$type}}, { %params, plugin => $plugin, q => $plugin->param( "qs" ), id => $plugin->get_id, }; } } # sort plugins internally by q then id for(values(%pset)) { @$_ = sort { $b->{q} <=> $a->{q} || $a->{id} cmp $b->{id} } @$_; } # sort supported types by the highest plugin score my @pset_order = sort { $pset{$b}->[0]->{q} <=> $pset{$a}->[0]->{q} } keys %pset; my $accept; if( $self->is_write ) { $accept = $r->headers_in->{'Content-Type'}; } else { # summary page is higher priority than anything else for /id/eprint/23 # and /id/contents if( ( $self->scope == CRUD_SCOPE_DATAOBJ && $self->{dataset}->base_id ne "subject" ) || $self->scope == CRUD_SCOPE_USER_CONTENTS ) { my $plugin = $repo->plugin( "Export::SummaryPage" ); my $mimetype = $plugin->param( "produce" ); $mimetype = join ',', @$mimetype; for( HTTP::Headers::Util::split_header_words( $mimetype ) ) { my( $type, undef, %params ) = @$_; unshift @pset_order, $type; unshift @{$pset{$type}}, { charset => 'utf-8', q => $plugin->param( "qs" ), plugin => $plugin, }; } } $accept = $r->headers_in->{Accept} || "*/*"; } my @accept = parse_media_range( $accept || "" ); my $match; CHOICE: foreach my $choice ( @accept ) { my( $mime_type, undef, %params ) = @$choice; my( $type, $subtype ) = split '/', $mime_type; # find matching entries by mime-type if( exists $pset{$mime_type} ) { # pick the best plugin based on parameters and then plugin qs my $plugins = $pset{$mime_type}; for(keys %params) { next if $_ eq "q"; foreach my $match (@$plugins) { $match->{q}++ if exists($match->{$_}) && $match->{$_} eq $params{$_}; } } $match = (sort { $b->{q} <=> $a->{q} || $a->{id} cmp $b->{id} } @$plugins)[0]->{plugin}; $r->pnotes->{mime_type} = $mime_type; last CHOICE; } # */* elsif( $type eq '*' && $subtype eq '*' ) { $match = $pset{$pset_order[0]}->[0]->{plugin}; $r->pnotes->{mime_type} = $mime_type; last CHOICE; } # text/* elsif( $subtype eq '*' ) { for(@pset_order) { if( m#^$type/# ) { $match = $pset{$_}->[0]->{plugin}; $r->pnotes->{mime_type} = $mime_type; last CHOICE; } } } } return $match; } ###################################################################### =pod =item EPrints::Apache::CRUD( $media_range ) Takes the C<$media_range> string and returns array of acceptable MIME types. See L for more detail. =cut ###################################################################### sub parse_media_range { my( $media_range ) = @_; my @accept = HTTP::Headers::Util::split_header_words( $media_range ); for(@accept) { my( $mime_type, undef, %params ) = @$_; $params{'mime_type'} = $mime_type; $params{q} = 1 if !defined $params{q}; $_ = \%params; } @accept = sort { # q-scores $b->{q} <=> $a->{q} || # text/html is higher than text/* $a->{mime_type} cmp $b->{mime_type} || # text/html;level=1 is higher than text/html scalar(keys %$b) <=> scalar(keys %$a) } @accept; return map { [ delete $_->{mime_type}, undef, %$_ ] } @accept; } ###################################################################### =pod =item $rc = $crud->handler Handler of CRUD requests. Returns HTTP response code. =cut ###################################################################### sub handler { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $plugin = $self->plugin; my $user = $repo->current_user; my( $rc, $owner ) = $self->on_behalf_of( $user ); return $rc if $rc != OK; # Subject URI's redirect to the top of that particular subject tree # rather than the node in the tree. if( UNIVERSAL::isa( $dataobj, "EPrints::DataObj::Subject" ) ) { $dataobj = $dataobj->top || $dataobj; $self->{dataobj} = $dataobj; } if( $self->method eq "DELETE" ) { return $self->DELETE( $owner ); } elsif( $self->method eq "POST" ) { return $self->POST( $owner ); } elsif( $self->method eq "PUT" ) { if( $self->scope == CRUD_SCOPE_CONTENTS ) { return $self->PUT_contents( $owner ); } else { return $self->PUT( $owner ); } } elsif( $self->method eq "PATCH" ) { return $self->PUT( $owner, "patch" => 1 ); } elsif( $self->method eq "GET" || $self->method eq "HEAD" || $self->method eq "OPTIONS" ) { $r->err_headers_out->{Allow} = join ',', $self->options; return $self->GET( $owner ); } return HTTP_METHOD_NOT_ALLOWED; } ###################################################################### =pod =item $rc = $crud->DELETE() Handle C requests. =over 4 =item HTTP_METHOD_NOT_ALLOWED Can't perform C on F. =item HTTP_NOT_FOUND No such object. =item HTTP_CONFLICT Lock conflict with another user. =item HTTP_NO_CONTENT Successfully removed the object. =back =cut ###################################################################### sub DELETE { my( $self ) = @_; my $repo = $self->repository; my $dataobj = $self->dataobj; my $user = $repo->current_user; # /id/contents return HTTP_METHOD_NOT_ALLOWED if $self->scope == CRUD_SCOPE_USER_CONTENTS; # already deleted? return NOT_FOUND if !defined $dataobj; # obtain parent lock, if available my $lock_obj = $dataobj; while( defined($lock_obj) && !$lock_obj->can( "obtain_lock" ) ) { $lock_obj = $lock_obj->can( "parent" ) ? $lock_obj->parent : undef; } if( defined $lock_obj ) { $lock_obj->obtain_lock( $user ) or return HTTP_CONFLICT; } # allow DELETE /id/foo/bar/contents because /contents is the edit-media URI if( $self->scope == CRUD_SCOPE_CONTENTS ) { $_->remove for @{$self->field->get_value( $dataobj )}; } else { $dataobj->remove; } if( defined $lock_obj && $lock_obj ne $dataobj ) { $lock_obj->remove_lock( $user ); } return HTTP_NO_CONTENT; } ###################################################################### =pod =item $rc = $crud->GET( [ $owner ] ) Handle C requests. =over 4 =item HTTP_NO_CONTENT No sub-objects in F. =item HTTP_NOT_ACCEPTABLE More than one sub-object in F. =item HTTP_UNSUPPORTED_MEDIA_TYPE No L plugin matches the C header/object type. =item HTTP_SEE_OTHER Redirect to a non-CRUD EPrints page. =item HTTP_NOT_FOUND Object not found. =item HTTP_OK Object outputted successfully. =back =cut ###################################################################### sub GET { my( $self, $owner ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $field = $self->field; my $plugin = $self->plugin; # what to do when the user doesn't ask for a specific content type if( $r->pnotes->{mime_type} eq "*/*" || $r->pnotes->{mime_type} eq "" ) { # GET/HEAD XX/contents without mime type, default to content if( $self->scope == CRUD_SCOPE_CONTENTS ) { if( $dataobj->isa( "EPrints::DataObj::EPrint" ) ) { my @docs = $dataobj->get_all_documents; if( @docs == 0 ) { return HTTP_NO_CONTENT; } elsif( @docs == 1 ) { $dataobj = $docs[0]; } else { return $self->sword_error( status => HTTP_NOT_ACCEPTABLE, summary => "More than one resource at this location", ); } } return EPrints::Apache::Rewrite::redir_see_other( $r, $dataobj->get_url ); } # GET/HEAD /id/contents without mime type, default to Atom elsif( $self->scope == CRUD_SCOPE_USER_CONTENTS ) { $plugin = $repo->plugin( "Export::Atom" ); } } return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin; if( $dataset->base_id eq "subject" ) { return EPrints::Apache::Rewrite::redir_see_other( $r, $plugin->dataobj_export_url( $dataobj ) ); } my %args = %{$plugin->param( "arguments" )}; # fetch the plugin arguments, if any foreach my $argname (keys %args) { if( defined $repo->param( $argname ) ) { $args{$argname} = $repo->param( $argname ); } } if( $self->scope == CRUD_SCOPE_USER_CONTENTS ) { my $indexOffset = $repo->param( "indexOffset" ) || 0; my $page_size = 20; my $base = $repo->current_url( host => 1 ); my $next = $base->clone; $next->query_form( indexOffset => $indexOffset + $page_size ); my $previous = $base->clone; $previous->query_form( indexOffset => $indexOffset - $page_size ); my $list = $owner->owned_eprints_list( limit => $indexOffset + $page_size, custom_order => "-lastmod", ); $list->{ids} = $list->ids( $indexOffset, $page_size ); $r->content_type( $plugin->param( "mimetype" ) ); $plugin->initialise_fh( \*STDOUT ); $plugin->output_list( startIndex => $indexOffset, list => $list, fh => \*STDOUT, offsets => { self => $repo->current_url( host => 1, query => 1 ), first => $base, next => $next, ($indexOffset >= $page_size ? (previous => $previous) : ()), }, ); } elsif( $self->scope == CRUD_SCOPE_CONTENTS ) { my $datasetid = $field->property( "datasetid" ); my @ids; if( $dataobj->isa( "EPrints::DataObj::EPrint" ) ) { @ids = map { $_->id } $dataobj->get_all_documents; } else { @ids = map { $_->id } @{$field->get_value( $dataobj )}; } $r->content_type( $plugin->param( "mimetype" ) ); $plugin->initialise_fh( \*STDOUT ); $plugin->output_list( %args, list => EPrints::List->new( session => $repo, dataset => $repo->dataset( $datasetid ), ids => \@ids ), fh => \*STDOUT, ); } elsif( $self->scope == CRUD_SCOPE_DATAOBJ ) { return HTTP_NOT_FOUND if !defined $dataobj; if ( $repo->config("use_long_url_format") && ($dataset->base_id eq "file") && ( !defined $plugin || $plugin->get_type ne "Export" ) ) { ## redirect /id/file/234 to /id/eprint/23/1.pdf (part of the 84_sword.pl test) when use_long_url_format is turned on, instead of the summary page of the file dataobj. my $url = $dataobj->get_url; if( defined( $url ) && $url ne $dataobj->uri ) { return EPrints::Apache::Rewrite::redir_see_other( $r, $url ); } } # user wants HTML and there is a static page available my $url = ($dataset->base_id eq "eprint" && $dataset->id ne "archive") ? $dataobj->get_control_url : $dataobj->get_url; if( $plugin->get_subtype eq "SummaryPage" ) { if( defined( $url ) && $url ne $dataobj->uri ) { return EPrints::Apache::Rewrite::redir_see_other( $r, $url ); } } # set Last-Modified header for individual objects if( my $field = $dataset->get_datestamp_field() ) { my $datestamp = $field->get_value( $dataobj ); $r->headers_out->{'Last-Modified'} = Apache2::Util::ht_time( $r->pool, EPrints::Time::datestring_to_timet( undef, $datestamp ) ); } $r->content_type( $plugin->param( "mimetype" ) ); if( $plugin->param( 'include_bom' ) ) { print $plugin->byte_order_mark; } $plugin->initialise_fh( \*STDOUT ); my $output = $plugin->output_dataobj( $dataobj, %args, fh => \*STDOUT, ); # optional for output_dataobj to support 'fh' print $output if defined $output; } # /id/eprint, not supported yet (what would it do?) else { return HTTP_NOT_FOUND; } return OK; } ###################################################################### =pod =item $rc = $crud->POST( [ $owner ] ) Handle C requests. =over 4 =item HTTP_METHOD_NOT_ALLOWED Can only POST to F. =item HTTP_BAD_REQUEST No plugin for the SWORD C header. =item HTTP_CREATED Object(s) successfully created. =back =cut ###################################################################### sub POST { my( $self, $owner ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $field = $self->field; my $plugin = $self->plugin; my $user = $repo->current_user; # can only post to XX/contents and /id/contents if( $self->scope != CRUD_SCOPE_CONTENTS && $self->scope != CRUD_SCOPE_USER_CONTENTS ) { return HTTP_METHOD_NOT_ALLOWED; } my $headers = $self->headers; my $rc = $self->check_packaging; return $rc if $rc != OK; # we can import any file type into /contents if( !defined $plugin ) { $plugin = $repo->plugin( "Import::Binary" ); } my @items; my $status; my $rev_number; if( $self->scope == CRUD_SCOPE_USER_CONTENTS ) { $status = $headers->{in_progress} ? "inbox" : "buffer"; my $ownerid = $owner->id; $status = "archive" if ( $repo->config("skip_buffer") || ( defined $repo->config("skip_buffer_owners") && grep( /^$ownerid$/, @{$repo->config("skip_buffer_owners")} ) ) && $status eq "buffer" ); } my $list = $self->parse_input( $plugin, sub { my( $epdata ) = @_; if (!$self->is_file_ok($epdata)) { $self->sword_error( status => HTTP_PRECONDITION_FAILED, href => "http://purl.org/net/sword/error/ErrorChecksumMismatch", summary => "Attachment file integrity check failed. (Filesize not specified, filesize does not match or MD5 checksum mismatch)", ); return undef; } if( $self->scope == CRUD_SCOPE_USER_CONTENTS ) { $epdata->{userid} = $owner->id; $epdata->{sword_depositor} = $user->id; $epdata->{eprint_status} = $status; $epdata->{rev_number} = $rev_number; push @items, $dataset->create_dataobj( $epdata ); } else { push @items, $dataobj->create_subdataobj( $field->name, $epdata ); } return $items[-1]; } ); return undef if !defined $list; if( $self->scope == CRUD_SCOPE_CONTENTS && $headers->{metadata_relevant} ) { $self->metadata_relevant( $items[0] ); } my $atom = $repo->plugin( "Export::Atom" ); # producing more than one item (potentially) if( $self->scope == CRUD_SCOPE_CONTENTS && $headers->{flags}->{unpack} ) { return $self->send_response( HTTP_CREATED, $atom->param( "mimetype" ), $atom->output_list( list => $list ), ); } else { $r->err_headers_out->{Location} = $items[0]->uri; # DEBUG CODE if( defined $field && $headers->{mime_type} ne "application/atom+xml" ) { $r->err_headers_out->{Location} = $items[0]->uri . '/contents'; } # DEBUG CODE return $self->send_response( HTTP_CREATED, $atom->param( "mimetype" ), $atom->output_dataobj( $items[0] ), ); } } ###################################################################### =pod =item $rc = $crud->PUT( [ $owner ] ) Handle C requests. =over 4 =item HTTP_UNSUPPORTED_MEDIA_TYPE No L plugin matched the C header/object type. =item HTTP_RANGE_NOT_SATISFIABLE C header is invalid or unsupported for the object type. =item HTTP_FORBIDDEN User does not have permission to create/update the object. =item HTTP_CREATED Object was successfully created. =item HTTP_NO_CONTENT Object was successfully updated. =back =cut ###################################################################### # PUT /id/eprint/23 sub PUT { my( $self, $owner, %opts ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $self->dataset; my $dataobj = $self->dataobj; my $plugin = $self->plugin; my $user = $repo->current_user; my $headers = $self->headers; my $rc = $self->check_packaging; return $rc if $rc != OK; if( !defined $plugin && $dataset->base_id eq "file" ) { $plugin = $repo->plugin( "Import::Binary" ); } return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin; # We support Content-Ranges for writing to files if( defined(my $offset = $headers->{offset}) ) { my $total = $headers->{total}; if( $dataset->base_id ne "file" || !defined $dataobj ) { return $self->sword_error( status => HTTP_RANGE_NOT_SATISFIABLE, summary => "Content-Range unsupported for ".$dataset->base_id, ); } my $tmpfile = $self->_read_content; return $r->status if !defined $tmpfile; if( $total eq '*' || ($offset + -s $tmpfile) > $total ) { return $self->sword_error( status => HTTP_RANGE_NOT_SATISFIABLE, summary => "Won't write beyond total file size (or total size not given)", ); } my $rlen = $dataobj->set_file_chunk( $tmpfile, -s $tmpfile, $offset, $total ); return $self->sword_error( status => HTTP_INTERNAL_SERVER_ERROR, summary => "Error occurred during writing - check server logs", ) if !defined $rlen; $dataobj->commit; return HTTP_NO_CONTENT; } my $epdata; my $list = $self->parse_input( $plugin, sub { ( $epdata ) = @_;return undef } ); return if !defined $list; if (!$self->is_file_ok($epdata)) { $self->sword_error( status => HTTP_PRECONDITION_FAILED, href => "http://purl.org/net/sword/error/ErrorChecksumMismatch", summary => "Filesize not specified or filesize does not match", ); return undef; } # implicit create on unknown URI if( !defined $dataobj ) { $dataobj = $self->create_dataobj( $owner ); return $self->sword_error( status => HTTP_FORBIDDEN, summary => "An item already exists at this location or you do not have sufficient privileges to create an item with a predefined identifier", ) if !defined $dataobj; } my( $old_status, $new_status ); if( $dataset->base_id eq "eprint" ) { $old_status = $dataobj->value( "eprint_status" ); $new_status = delete $epdata->{eprint_status}; $epdata->{userid} = $owner->id; $epdata->{sword_depositor} = $user->id; $epdata->{eprint_status} = $old_status; $epdata->{rev_number} = $dataobj->value( "rev_number" ); # check the user has permission to move this eprint, before we perform # any other changes. my $priv = "eprint/$old_status/move_$new_status"; if( EPrints::Utils::is_set( $new_status ) && $new_status ne $old_status && !$user->allow( $priv, $dataobj ) ) { return $self->sword_error( status => HTTP_FORBIDDEN, summary => "Insufficient privileges to transfer item from $old_status to $new_status", ); } } $dataobj->empty() unless ( defined $opts{patch} ); #$dataobj->set_value('eprint_status','inbox') if $dataobj->get_dataset_id() eq "eprint"; $dataobj->update( $epdata, include_subdataobjs => 1 ); $dataobj->commit; # transfer the eprint, if needed if( EPrints::Utils::is_set( $new_status ) && $new_status ne $old_status ) { $dataobj->_transfer( $new_status ); } if( !defined $self->dataobj ) { my $atom = $repo->plugin( "Export::Atom" ); $self->request->err_headers_out->{Location} = $dataobj->uri; return $self->send_response( HTTP_CREATED, $atom->param( "mimetype" ), $atom->output_dataobj( $dataobj ), ); } return HTTP_NO_CONTENT; } ###################################################################### =pod =item $rc = $crud->PUT_contents( [ $owner ] ) Equivalent to C then C. See L and L. =cut ###################################################################### sub PUT_contents { my( $self, $owner ) = @_; my $repo = $self->repository; my $dataobj = $self->dataobj; my $plugin = $self->plugin; my $field = $self->field; my $headers = $self->headers; my $rc = $self->check_packaging; return $rc if $rc != OK; # we can import any file type into XX/contents if( !defined $plugin ) { $plugin = $repo->plugin( "Import::Binary" ); } return HTTP_UNSUPPORTED_MEDIA_TYPE if !defined $plugin; # PUT /XX/contents implies DELETE existing contents $_->remove for @{$field->get_value( $dataobj )}; my @items; my $list = $self->parse_input( $plugin, sub { my( $epdata ) = @_; push @items, $dataobj->create_subdataobj( $field->name, $epdata ); return $items[-1]; } ); return if !defined $list; if( $headers->{metadata_relevant} ) { $self->metadata_relevant( $items[0] ); } return HTTP_NO_CONTENT; } ###################################################################### =pod =item $crud->metadata_relevant( $file ) Test and if suitable use C<$file> as metadata source to update the associated L. =cut ###################################################################### sub metadata_relevant { my( $self, $file ) = @_; my $repo = $self->repository; if( $file->isa( "EPrints::DataObj::EPrint" ) ) { $file = ($file->get_all_documents())[0]; } if( defined $file && $file->isa( "EPrints::DataObj::Document" ) ) { $file = $file->stored_file( $file->value( "main" ) ); } return if !defined $file; my $eprint = eval { $file->parent->parent }; return if !defined $eprint; my $fh = $file->get_local_copy; return if !defined $fh; my $dataset = $repo->dataset( "eprint" ); my $epdata = {}; my @plugins = $repo->get_plugins( type => "Import", can_accept => $file->value( "mime_type" ), can_produce => "dataobj/".$dataset->base_id, can_action => "metadata", ); @plugins = sort { $a->{qs} <=> $b->{qs} } @plugins; my @messages; my $handler = EPrints::CLIProcessor->new( message => sub { push @messages, $_[1] }, epdata_to_dataobj => sub { my( $data ) = @_; foreach my $fieldname (keys %$data) { next if !$dataset->has_field( $fieldname ); my $f = $dataset->field( $fieldname ); delete $epdata->{$fieldname} if exists $epdata->{$fieldname}; $epdata->{$fieldname} = $data->{$fieldname}; } return undef; } ); foreach my $plugin ( @plugins ) { $plugin->set_handler( $handler ); seek($fh,0,0); $plugin->input_fh( fh => $fh, dataset => $dataset, filename => $file->value( "filename" ), actions => ["metadata"], ); } for(qw( eprint_status userid sword_depositor rev_number )) { $epdata->{$_} = $eprint->value( $_ ); } $eprint->empty(); $eprint->update( $epdata ); $eprint->commit; } ###################################################################### =pod =item $crud->servicedocument Generate response containing CRUD service document. =cut ###################################################################### sub servicedocument { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my $dataset = $repo->dataset( "eprint" ); my $xml = $repo->xml; my $user = $repo->current_user; EPrints->abort( "unprotected" ) if !defined $user; # Rewrite foobar my ( $status, $on_behalf_of ) = $self->on_behalf_of( $user ); if( $status != OK ) { return $self->sword_error( status => HTTP_FORBIDDEN, href => "http://purl.org/net/sword/error/TargetOwnerUnknown", summary => "Target user unknown or no permission to act on-behalf-of", ); } # SERVICE and WORKSPACE DEFINITION my $service = $xml->create_element( "service", xmlns => "http://www.w3.org/2007/app", "xmlns:atom" => "http://www.w3.org/2005/Atom", "xmlns:sword" => "http://purl.org/net/sword/", "xmlns:dcterms" => "http://purl.org/dc/terms/" ); my $title = $repo->phrase( "archive_name" ) . ": " . $repo->phrase( "Plugin/Screen/Items:title" ); my $workspace = $xml->create_data_element( "workspace", [ [ "atom:title", $title ], # SWORD LEVEL [ "sword:version", "2.0" ], # SWORD VERBOSE (Unsupported) # [ "sword:verbose", "true" ], # SWORD NOOP (Unsupported) # [ "sword:noOp", "true" ], ]); $service->appendChild( $workspace ); my $collection = $xml->create_data_element( "collection", [ # COLLECTION TITLE [ "atom:title", $repo->dataset( "eprint" )->render_name ], # COLLECTION POLICY # [ "sword:collectionPolicy", $service_conf->{sword_policy} ], # COLLECTION MEDIATED [ "sword:mediation", "true" ], # DCTERMS ABSTRACT # [ "dcterms:abstract", $service_conf->{dcterms_abstract} ], # COLLECTION TREATMENT # [ "sword:treatment", $treatment ], ], "href" => $repo->current_url( host => 1, path => "static", "id/contents" ), ); $workspace->appendChild( $collection ); if( $user->allow( "create_eprint" ) ) { foreach my $plugin ($self->import_plugins( is_advertised => 1 )) { foreach my $mime_type (@{$plugin->param( "accept" )}) { if( $mime_type =~ /^$PACKAGING_PREFIX(.+)$/ ) { $collection->appendChild( $xml->create_data_element( "sword:acceptPackaging", $1 ) ); } else { $collection->appendChild( $xml->create_data_element( "accept", $mime_type, alternate => "multipart-related" ) ); } } } # we always accept simple files $collection->appendChild( $xml->create_data_element( "acceptPackaging", "http://purl.org/net/sword/package/Binary" ) ); $collection->appendChild( $xml->create_data_element( "accept", "application/octet-stream", alternate => "multipart-related" ) ); } else { $collection->appendChild( $xml->create_data_element( "accept" ) ); } my $categories = $collection->appendChild( $xml->create_element( "categories", fixed => "yes" ) ); foreach my $type ($dataset->field( "type" )->tags) { $categories->appendChild( $xml->create_element( "atom:category", scheme => $repo->config( "base_url" )."/data/eprint/type", term => $type, ) ); } foreach my $type ($dataset->field( "eprint_status" )->tags) { $categories->appendChild( $xml->create_element( "atom:category", scheme => EPrints::Const::EP_NS_DATA . "/eprint/eprint_status", term => $type, ) ); } my $content = "\n" . $xml->to_string( $service, indent => 1 ); return $self->send_response( OK, 'application/atomsvc+xml; charset=utf-8', $content ); } ###################################################################### =pod =item $rc = $crud->on_behalf_of( $user ) Submit CRUD request on behalf of another user. Returns HTTPS response code based on whether request on behalf of is permitted. =cut ###################################################################### sub on_behalf_of { my( $self, $user ) = @_; my $repo = $self->repository; my $r = $self->request; my $on_behalf_of = $r->headers_in->{'On-Behalf-Of'} || # SWORD 2.0 $r->headers_in->{'X-On-Behalf-Of'}; # SWORD 1.3 return( OK, $user ) if !$on_behalf_of; my $owner = $repo->user_by_username( $on_behalf_of ); return ( HTTP_FORBIDDEN, undef ) if !defined $owner; return ( HTTP_FORBIDDEN, undef ) if !$user->allow( "user/mediate", $owner ); return( OK, $owner ); } ###################################################################### =pod =item $boolean = $crud->is_file_ok( $epdata ) Tests if files with C<$epdata> were uploaded with corruption. =cut ###################################################################### sub is_file_ok { my( $self, $epdata ) = @_; my $file_checking_succ=1; return $file_checking_succ unless defined $epdata->{documents}; foreach my $doc (@{$epdata->{documents}}) { foreach (@{$doc->{files}}) { my $content = $_->{_content}; if (defined $content) ##when content is defined, we expect the filesize exist and same as the the one in xml. { if (!defined $_->{filesize}) { $file_checking_succ=0; } my $filesize = -s $content; if ($filesize ne $_->{filesize}) ##if file size do not match, file check fail { $file_checking_succ=0; } ##checking md5 checksum if (defined($_->{hash_type}) && defined($_->{hash})) { if (lc($_->{hash_type}) eq 'md5') { my $ctx = Digest::MD5->new->addfile($content); seek($content,0,0); if ($ctx->hexdigest ne $_->{hash}) { $file_checking_succ=0; } } } } } } return $file_checking_succ; } ###################################################################### =pod =item $boolean = $crud->process_headers Process headers of CRUD request =cut ###################################################################### sub process_headers { my( $self ) = @_; my $r = $self->request; my $repo = $self->repository; my %response; $self->{headers} = \%response; # X-Method (pseudo-PUTs etc. from POST) $self->{method} = uc($r->method); if( $self->method eq "POST" ) { if( $r->headers_in->{'X-Method'} ) { $self->{method} = uc($r->headers_in->{'X-Method'}); } # or via Ruby-on-Rails "_method" query parameter my %q = URI::http->new( $r->unparsed_uri )->query_form; if( $q{_method} ) { $self->{method} = uc($q{_method}); } } # In-Progress $response{in_progress} = is_true( $r->headers_in->{'In-Progress'} ); # X-Verbose $response{verbose} = is_true( $r->headers_in->{'X-Verbose'} ); # Content-Type $response{content_type} = $r->headers_in->{'Content-Type'}; $response{content_type} = "application/octet-stream" if !EPrints::Utils::is_set( $response{content_type} ); ( $response{mime_type}, my %params ) = @{(HTTP::Headers::Util::split_header_words($response{content_type}))[0]}; $response{content_type_params} = \%params; # Content-Length $response{content_length} = $r->headers_in->{'Content-Length'}; # Content-Range my $range = $r->headers_in->{'Content-Range'}; if( defined $range ) { if( $range =~ m{^(\d+)-(\d+)/(\d+|\*)$} && $1 <= $2 ) { $response{content_range} = $range; $response{offset} = $1; $response{total} = $3; if( !defined $response{content_length} ) { $response{content_length} = $2 - $1; } } else { return HTTP_RANGE_NOT_SATISFIABLE; } } # Content-MD5 $response{content_md5} = $r->headers_in->{'Content-MD5'}; # Content-Disposition my @values = @{(HTTP::Headers::Util::split_header_words( $r->headers_in->{'Content-Disposition'} || '' ))[0] || []}; for(my $i = 0; $i < @values; $i += 2) { if( $values[$i] eq "filename" ) { $response{filename} = $values[$i+1]; } } $response{filename} = "main.bin" if !EPrints::Utils::is_set( $response{filename} ); ($response{extension}) = $response{filename} =~ /((?:\.[^\.]+){1,2})$/; # X-No-Op $response{no_op} = is_true( $r->headers_in->{'X-No-Op'} ); # X-Packaging $response{packaging} = $r->headers_in->{'Packaging'} || # SWORD 2.0 $r->headers_in->{'X-Packaging'} || # SWORD 1.3 $r->headers_in->{'X-Format-Namespace'}; # SWORD 1.2 # Slug $response{slug} = $r->headers_in->{'Slug'}; # userAgent $response{user_agent} = $r->headers_in->{'User-Agent'}; # Metadata-relevant $response{metadata_relevant} = is_true($r->headers_in->{'Metadata-Relevant'}) || # SWORD 2.0 is_true($r->headers_in->{'X-Override-Metadata'}); # SWORD 2.0a # actions my $actions = $response{actions} = []; # push @$actions, "metadata" if $response{metadata_relevant}; push @$actions, "unpack" if $response{packaging} && $response{packaging} eq "http://purl.org/net/sword/package/SimpleZip"; $response{flags} = {map { $_ => 1 } @$actions}; return OK; } ###################################################################### =pod =item $boolean = $crud->sword_error( %opts ) Generate SWORD error documents based on provided C<%opts>. =cut ###################################################################### sub sword_error { my( $self, %opts ) = @_; my $r = $self->request; my $repo = $self->repository; my $xml = generate_error_document( $repo, %opts ); $opts{status} = HTTP_BAD_REQUEST if !defined $opts{status}; $r->status( $opts{status} ); return $self->send_response( $opts{status}, 'application/xml; charset=UTF-8', $xml ); } ###################################################################### =pod =item $boolean = $crud->plugin_error( $plugin, $messages ) Generate error message for import C<$plugin> used with C<$messages> provided. =cut ###################################################################### sub plugin_error { my( $self, $plugin, $messages ) = @_; my $repo = $self->repository; $plugin->handler->message( "error", $@ ) if $@ ne "\n"; my $ul = $repo->xml->create_element( "ul" ); for(@{$messages}) { $ul->appendChild( $repo->xml->create_data_element( "li", $_ ) ); } my $err = $repo->xhtml->to_xhtml( $ul ); $repo->xml->dispose( $ul ); return $self->sword_error( status => HTTP_INTERNAL_SERVER_ERROR, summary => $err ); } ###################################################################### =pod =item $rc = $crud->send_response( $status, $content_type, $content ) Output response to CRUD request with HTTP status code C<$status>, content type C<$content_type>. Returns HTTP response code C. =cut ###################################################################### sub send_response { my( $self, $status, $content_type, $content ) = @_; my $r = $self->request; use bytes; $r->status( $status == OK ? HTTP_OK : $status ); $r->content_type( $content_type ); if( defined $content ) { $r->err_headers_out->{'Content-Length'} = length $content; binmode(STDOUT, ":utf8"); print $content; } return OK; } 1; ###################################################################### =pod =back =head1 SEE ALSO http://en.wikipedia.org/wiki/Create,_read,_update_and_delete http://en.wikipedia.org/wiki/Content_negotiation =head1 COPYRIGHT =begin COPYRIGHT Copyright 2023 University of Southampton. EPrints 3.4 is supplied by EPrints Services. http://www.eprints.org/eprints-3.4/ =end COPYRIGHT =begin LICENSE This file is part of EPrints 3.4 L. EPrints 3.4 and this file are released under the terms of the GNU Lesser General Public License version 3 as published by the Free Software Foundation unless otherwise stated. EPrints 3.4 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with EPrints 3.4. If not, see L. =end LICENSE