Scp.pm

   1 #! /usr/bin/env perl
   2 ###################################################
   3 #
   4 #  Copyright (C) 2012 Christian Weiske <[email protected]>
   5 #
   6 #  This file is part of Shutter.
   7 #
   8 #  Shutter is free software; you can redistribute it and/or modify
   9 #  it under the terms of the GNU General Public License as published by
  10 #  the Free Software Foundation; either version 3 of the License, or
  11 #  (at your option) any later version.
  12 #
  13 #  Shutter is distributed in the hope that it will be useful,
  14 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 #  GNU General Public License for more details.
  17 #
  18 #  You should have received a copy of the GNU General Public License
  19 #  along with Shutter; if not, write to the Free Software
  20 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21 #
  22 ###################################################
  23
  24 package Scp;
  25
  26 use lib $ENV{'SHUTTER_ROOT'}.'/share/shutter/resources/modules';
  27
  28 use utf8;
  29 use strict;
  30 use POSIX qw/setlocale/;
  31 use Locale::gettext;
  32 use Glib qw/TRUE FALSE/;
  33
  34 use Shutter::Upload::Shared;
  35 our @ISA = qw(Shutter::Upload::Shared);
  36
  37 my $d = Locale::gettext->domain("shutter-upload-plugins");
  38 $d->dir( $ENV{'SHUTTER_INTL'} );
  39
  40 my %upload_plugin_info = (
  41     'module'       => "Scp",
  42     'url'          => "",
  43     'registration' => "",
  44     'description'  => $d->get( "Copy photos via scp. Use user as remote path, password as URL base" ),
  45     'supports_anonymous_upload'  => FALSE,
  46     'supports_authorized_upload' => TRUE,
  47 );
  48
  49 binmode( STDOUT, ":utf8" );
  50 if ( exists $upload_plugin_info{$ARGV[ 0 ]} ) {
  51         print $upload_plugin_info{$ARGV[ 0 ]};
  52         exit;
  53 }
  54
  55 ###################################################
  56
  57 sub new {
  58         my $class = shift;
  59
  60         #call constructor of super class (host, debug_cparam, shutter_root, gettext_object, main_gtk_window, ua)
  61         my $self = $class->SUPER::new( shift, shift, shift, shift, shift, shift );
  62
  63         bless $self, $class;
  64         return $self;
  65 }
  66
  67 sub init {
  68         my $self = shift;
  69         use URI::Escape;
  70         return TRUE;
  71 }
  72
  73 sub upload {
  74         my ( $self, $upload_filename, $username, $password ) = @_;
  75
  76         #store as object vars
  77         $self->{_filename} = $upload_filename;
  78
  79         utf8::encode $upload_filename;
  80         utf8::encode $password;
  81         utf8::encode $username;
  82
  83         $upload_filename =~ m/\/([^\/]*$)/;
  84         my $file = $1;
  85
  86         my $target_filename = $username . "/" . $file;
  87         $target_filename =~ s/ /\\ /g;
  88
  89         my @args = ("scp", $upload_filename, $target_filename);
  90         system(@args);
  91         if ($? == 0) {
  92             #status: success
  93             $self->{_links}{'status'} = 200;
  94             $self->{_links}{'url'} = $password . uri_escape($file);
  95         } else {
  96             #status: error
  97             $self->{_links}{'status'} = "exec failed: @args / $?";
  98         }
  99         #and return links
 100         return %{ $self->{_links} };
 101 }
 102
 103 1;