lib/CloudStore/API.pm

   1 package CloudStore::API;
   2 use warnings;
   3 use strict;
   4 use autodie;
   5
   6 use Data::Dump qw(dump);
   7
   8 sub new {
   9         my $class = shift;
  10         my $self = {@_};
  11         bless $self, $class;
  12
  13         $self->{passwd} ||= '/var/lib/extrausers/passwd';
  14         $self->{PORT}   ||= $ENV{PORT}  || die "no PORT in env";
  15         $self->{SLICE}  ||= $ENV{SLICE} || die "no SLICE in env";
  16
  17         return $self;
  18 }
  19
  20 sub user_info {
  21         my ($self,$login) = @_;
  22
  23         my @n = qw/ login passwd uid gid quota comment gecos dir shell expire /;
  24         my @p = $login =~ m/^\d+$/ ? getpwuid $login : getpwnam $login;
  25 warn "## $login ",dump(@p);
  26         die "$login: $!" if $!;
  27         my $user;
  28         $user->{$_} = shift @p foreach @n;
  29         return $user;
  30 }
  31
  32 sub create_user {
  33         my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
  34
  35         my $max_uid = 0;
  36         my $found = 0;
  37
  38         open(my $fh, '<', $self->{passwd});
  39         while(<$fh>) {
  40                 my ( $login, $passwd, $uid, $gid, $email, $dir, $shell ) = split(/:/,$_);
  41                 $max_uid = $uid if $uid > $max_uid;
  42                 $found = $uid if $email eq $new_email;
  43         }
  44         close($fh);
  45
  46         if ( ! $found ) {
  47                 $max_uid++;
  48                 my $dir = "$self->{SLICE}/$max_uid";
  49                 warn "# create_user $new_email $new_quota = $max_uid $dir";
  50                 open(my $fh, '>>', $self->{passwd});
  51                 print $fh "u$max_uid:$new_passwd:$max_uid:$self->{PORT}:$new_email:$dir:/bin/true\n";
  52                 close($fh);
  53                 $found = $max_uid;
  54
  55                 mkdir $dir;
  56                 chown $max_uid, $self->{PORT}, $dir;
  57         }
  58
  59         return $found;
  60 }
  61
  62 sub send_file {
  63         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
  64
  65
  66 }
  67
  68 sub rename_file {
  69         my ( $uid, $from, $to ) = @_;
  70 }
  71
  72
  73 sub delete {
  74         my ( $uid, $path ) = @_;
  75
  76 }
  77
  78 sub usage {
  79         my ( $uid ) = @_;
  80
  81 }
  82
  83 1;