FS/FS/upload_target.pm

   1 package FS::upload_target;
   2
   3 use strict;
   4 use base qw( FS::Record );
   5 use FS::Record qw( qsearch qsearchs );
   6 use FS::Misc qw(send_email);
   7 use FS::Conf;
   8 use File::Spec;
   9 use vars qw($me $DEBUG);
  10
  11 $DEBUG = 0;
  12
  13 =head1 NAME
  14
  15 FS::upload_target - Object methods for upload_target records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::upload_target;
  20
  21   $record = new FS::upload_target \%hash;
  22   $record = new FS::upload_target { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::upload_target object represents a destination to deliver files (such
  35 as invoice batches) by FTP, SFTP, or email.  FS::upload_target inherits from
  36 FS::Record.
  37
  38 =over 4
  39
  40 =item targetnum - primary key
  41
  42 =item agentnum - L<FS::agent> foreign key; can be null
  43
  44 =item protocol - 'ftp', 'sftp', or 'email'.
  45
  46 =item hostname - the DNS name of the FTP site, or the domain name of the
  47 email address.
  48
  49 =item port - the TCP port number, if it's not standard.
  50
  51 =item username - username
  52
  53 =item password - password
  54
  55 =item path - for FTP/SFTP, the working directory to change to upon connecting.
  56
  57 =item subject - for email, the Subject: header
  58
  59 =item handling - a string naming an additional process to apply to
  60 the file before sending it.
  61
  62 =back
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =cut
  69
  70 sub table { 'upload_target'; }
  71
  72 =item new HASHREF
  73
  74 Creates a new FTP target.  To add it to the database, see L<"insert">.
  75
  76 =item insert
  77
  78 Adds this record to the database.  If there is an error, returns the error,
  79 otherwise returns false.
  80
  81 =item delete
  82
  83 Delete this record from the database.
  84
  85 =item replace OLD_RECORD
  86
  87 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  88 returns the error, otherwise returns false.
  89
  90 =item check
  91
  92 Checks all fields to make sure this is a valid example.  If there is
  93 an error, returns the error, otherwise returns false.  Called by the insert
  94 and replace methods.
  95
  96 =cut
  97
  98 sub check {
  99   my $self = shift;
 100
 101   my $protocol = lc($self->protocol);
 102   if ( $protocol eq 'email' ) {
 103     $self->set(password => '');
 104     $self->set(port => '');
 105     $self->set(path => '');
 106   } elsif ( $protocol eq 'sftp' ) {
 107     $self->set(port => 22) unless $self->get('port');
 108     $self->set(subject => '');
 109   } elsif ( $protocol eq 'ftp' ) {
 110     $self->set('port' => 21) unless $self->get('port');
 111     $self->set(subject => '');
 112   } else {
 113     return "protocol '$protocol' not supported";
 114   }
 115   $self->set(protocol => $protocol); # lowercase it
 116
 117   my $error =
 118     $self->ut_numbern('targetnum')
 119     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 120     || $self->ut_text('hostname')
 121     || $self->ut_text('username')
 122     || $self->ut_textn('password')
 123     || $self->ut_numbern('port')
 124     || $self->ut_textn('path')
 125     || $self->ut_textn('subject')
 126     || $self->ut_enum('handling', [ $self->handling_types ])
 127   ;
 128   return $error if $error;
 129
 130   $self->SUPER::check;
 131 }
 132
 133 =item put LOCALNAME [ REMOTENAME ]
 134
 135 Uploads the file named LOCALNAME, optionally changing its name to REMOTENAME
 136 on the target.  For FTP/SFTP, this opens a connection, changes to the working
 137 directory (C<path>), and PUTs the file.  For email, it composes an empty
 138 message and attaches the file.
 139
 140 Returns an error message if anything goes wrong.
 141
 142 =cut
 143
 144 sub put {
 145   my $self = shift;
 146   my $localname = shift;
 147   my @s = File::Spec->splitpath($localname);
 148   my $remotename = shift || $s[-1];
 149
 150   my $conf = FS::Conf->new;
 151   if ( $self->protocol eq 'ftp' or $self->protocol eq 'sftp' ) {
 152     # could cache this if we ever want to reuse it
 153     local $@;
 154     my $connection = eval { $self->connect };
 155     return $@ if $@;
 156     $connection->put($localname, $remotename);
 157     return $connection->error || '';
 158   } elsif ( $self->protocol eq 'email' ) {
 159
 160     my $to = join('@', $self->username, $self->hostname);
 161     # XXX if we were smarter, this could use a message template for the
 162     # message subject, body, and source address
 163     # (maybe use only the raw content, so that we don't have to supply a
 164     # customer for substitutions? ewww.)
 165     my %message = (
 166       'from'          => $conf->config('invoice_from_name') ?
 167                          $conf->config('invoice_from_name') . ' <' .
 168                          $conf->config('invoice_from') . '>' :
 169                          $conf->config('invoice_from'),
 170       'to'            => $to,
 171       'subject'       => $self->subject,
 172       'nobody'        => 1,
 173       'mimeparts'     => [
 174         { Path            => $localname,
 175           Type            => 'application/octet-stream',
 176           Encoding        => 'base64',
 177           Filename        => $remotename,
 178           Disposition     => 'attachment',
 179         }
 180       ],
 181     );
 182     return send_email(%message);
 183
 184   } else {
 185     return "unknown protocol '".$self->protocol."'";
 186   }
 187 }
 188
 189 =item connect
 190
 191 Creates a Net::FTP or Net::SFTP::Foreign object (according to the setting
 192 of the 'secure' flag), connects to 'hostname', attempts to log in with
 193 'username' and 'password', and changes the working directory to 'path'.
 194 On success, returns the object.  On failure, dies with an error message.
 195
 196 Always returns an error for email targets.
 197
 198 =cut
 199
 200 sub connect {
 201   my $self = shift;
 202   if ( $self->protocol eq 'sftp' ) {
 203     eval "use Net::SFTP::Foreign;";
 204     die $@ if $@;
 205     my %args = (
 206       user      => $self->username,
 207       timeout   => 30,
 208       autodie   => 0, #we're doing this anyway
 209     );
 210     # Net::SFTP::Foreign does not deal well with args that are defined
 211     # but empty
 212     $args{port} = $self->port if $self->port and $self->port != 22;
 213     $args{password} = $self->password if length($self->password) > 0;
 214     $args{more} = '-v' if $DEBUG;
 215     my $sftp = Net::SFTP::Foreign->new($self->hostname, %args);
 216     $sftp->setcwd($self->path);
 217     return $sftp;
 218   }
 219   elsif ( $self->protocol eq 'ftp') {
 220     eval "use Net::FTP;";
 221     die $@ if $@;
 222     my %args = (
 223       Debug   => $DEBUG,
 224       Port    => $self->port,
 225       Passive => 1,# optional?
 226     );
 227     my $ftp = Net::FTP->new($self->hostname, %args)
 228       or die "connect to ".$self->hostname." failed: $@";
 229     $ftp->login($self->username, $self->password)
 230       or die "login to ".$self->username.'@'.$self->hostname." failed: $@";
 231     $ftp->binary; #optional?
 232     $ftp->cwd($self->path)
 233       or ($self->path eq '/')
 234       or die "cwd to ".$self->hostname.'/'.$self->path." failed: $@";
 235
 236     return $ftp;
 237   } else {
 238     return "can't connect() to a target of type '".$self->protocol."'";
 239   }
 240 }
 241
 242 =item label
 243
 244 Returns a descriptive label for this target.
 245
 246 =cut
 247
 248 sub label {
 249   my $self = shift;
 250   $self->targetnum . ': ' . $self->username . '@' . $self->hostname;
 251 }
 252
 253 =item handling_types
 254
 255 Returns a list of values for the "handling" field, corresponding to the
 256 known ways to preprocess a file before uploading.  Currently those are
 257 implemented somewhat crudely in L<FS::Cron::upload>.
 258
 259 =cut
 260
 261 sub handling_types {
 262   '',
 263   #'billco', #not implemented this way yet
 264   'bridgestone',
 265   'ics',
 266 }
 267
 268 =back
 269
 270 =head1 BUGS
 271
 272 Handling methods should be here, but instead are in FS::Cron.
 273
 274 =head1 SEE ALSO
 275
 276 L<FS::Record>, schema.html from the base documentation.
 277
 278 =cut
 279
 280 1;
 281