ALT Linux Sisyphus - Пакет perl-Alterator-Automate

Alterator-Automate-0.03/000075500000000000000000000000001161131266100151425ustar00rootroot00000000000000Alterator-Automate-0.03/Changes000064400000000000000000000002521161131266100164340ustar00rootroot00000000000000Revision history for Perl extension Alterator::Automate.

0.01  Fri Jul 15 00:23:54 2011
	- original version; created by h2xs 1.23 with options
		-n Alterator::Automate

Alterator-Automate-0.03/MANIFEST000064400000000000000000000000761161131266100162760ustar00rootroot00000000000000Changes
Makefile.PL
MANIFEST
README
lib/Alterator/Automate.pm
Alterator-Automate-0.03/Makefile.PL000064400000000000000000000026541161131266100171230ustar00rootroot00000000000000use 5.012003;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
    NAME              => 'Alterator::Automate',
    VERSION_FROM      => 'lib/Alterator/Automate.pm', # finds $VERSION
    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
      (ABSTRACT_FROM  => 'lib/Alterator/Automate.pm', # retrieve abstract from module
       AUTHOR         => 'Anton V. Boyarshinov <boyarsh@altlinu.org>') : ()),
    LIBS              => [''], # e.g., '-lm'
    DEFINE            => '', # e.g., '-DHAVE_SOMETHING'
    INC               => '-I.', # e.g., '-I. -I/usr/include/other'
	# Un-comment this if you add C files to link with later:
    # OBJECT            => '$(O_FILES)', # link all the C files too
);
if  (eval {require ExtUtils::Constant; 1}) {
  # If you edit these definitions to change the constants used by this module,
  # you will need to use the generated const-c.inc and const-xs.inc
  # files to replace their "fallback" counterparts before distributing your
  # changes.
  my @names = (qw());
  ExtUtils::Constant::WriteConstants(
                                     NAME         => 'Alterator::Automate',
                                     NAMES        => \@names,
                                     DEFAULT_TYPE => 'IV',
                                  );

}
Alterator-Automate-0.03/README000064400000000000000000000022571161131266100160300ustar00rootroot00000000000000Alterator-Automate version 0.01
===============================

The README is used to introduce the module and provide instructions on
how to install the module, any machine dependencies it may have (for
example C compilers and installed libraries) and any other information
that should be provided before the module is installed.

A README file is required for CPAN modules since CPAN extracts the
README file from a module distribution so that people browsing the
archive can use it get an idea of the modules uses. It is usually a
good idea to provide version information here so that people can
decide whether fixes for the module are worth downloading.

INSTALLATION

To install this module type the following:

   perl Makefile.PL
   make
   make test
   make install

DEPENDENCIES

This module requires these other modules and libraries:

  blah blah blah

COPYRIGHT AND LICENCE

Put the correct copyright and licence information here.

Copyright (C) 2011 by Anton V. Boyarshinov

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.12.3 or,
at your option, any later version of Perl 5 you may have available.

Alterator-Automate-0.03/lib/000075500000000000000000000000001161131266100157105ustar00rootroot00000000000000Alterator-Automate-0.03/lib/Alterator/000075500000000000000000000000001161131266100176455ustar00rootroot00000000000000Alterator-Automate-0.03/lib/Alterator/Automate.pm000064400000000000000000000120151161131266100217610ustar00rootroot00000000000000package Alterator::Automate;

use 5.012003;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use strict;
use warnings;
use Carp;
use Data::Dumper;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Alterator::Automate ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.03';

sub new {
	my $class = shift;
	my $host = shift;
	my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 } );
	my $self  = { host => $host,
	ua => $ua };
	bless( $self, $class );
}

sub auth{
	my $self = shift;
	my $password = shift;
	my $req = POST "https://$self->{host}:8080/login?continue=1&ajax=commit-login",
	     [login => 'root', password => $password, locale => 'en_US' ];

	my $resp = $self->{ua}->request($req);

	my $content = $resp->{_content};
	my ($name,$value) = ($content =~ /form_update_cookie\("([^"]*)","([^"]*)"\)/);
	$self->{session}=$value;
}

sub put_key{
	my $self = shift;
	my $put_key = POST "https://$self->{host}:8080/root?ajax=ui-key-add",
	    Cookie =>	"session=$self->{session}",
	    Content_Type => 'form-data',
	    Content      => [ key_file => ["$ENV{HOME}/.ssh/id_rsa.pub"] ];

	$self->{ua}->request($put_key);
}

sub dhcp{
	my $self = shift;
	my $daemon = shift;
	my $iface = shift;
	my $start = shift;
	my $end = shift;
	my $dns = shift;
	my $search = shift;
	my $gw = shift;

	$daemon=$daemon?'#t':'#f';
	my $dhcp = POST "https://$self->{host}:8080/dhcp?ajax=ui-general-write",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ daemon => $daemon,
		         iface => $iface,
			 ip_start => $start,
			 ip_end => $end,
			 client_time => 3600,
			 client_dns => $dns,
			 client_search => $search,
			 client_gw => $gw
		    ];

	$self->{ua}->request($dhcp);
}

sub domain{
	my $self = shift;
	my $domain = shift;

	my $req = POST "https://$self->{host}:8080/net-domain?ajax=ui-write",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ domain => $domain,
		         master => '#t',
		    ];

	my $resp = $self->{ua}->request($req);
	my $content = $resp->{_content};
	print $content if $content =~ /Error/;
}

sub netinst_add{
	my $self = shift;
	my $url = shift;
	my $add;

	if ( $url eq 'cd://' ) {
	$add = POST "https://$self->{host}:8080/netinst?ajax=ui-add",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ get_from => 'cd',
		         add_url => '',
		    ];
	}
	else {
	$add = POST "https://$self->{host}:8080/netinst?ajax=ui-add",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ get_from => 'url',
		         add_url => $url,
		    ];
	}

	my $ar = $self->{ua}->request($add);

	my $wait = POST "https://$self->{host}:8080/netinst/wait?ajax=update-progress",
	        Cookie  =>  "session=$self->{session}" ;   

#see progress and wait
	for (my $i=0; $i<1000; $i++) {
		my $resp = $self->{ua}->request($wait);
		my %vals = $self->parse_values($resp->{_content});
		last if $vals{percent} == 100;
		sleep 2;
	}
	my $select = POST "https://$self->{host}:8080/netinst?ajax=ui-select",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ image => 1,
		    ];
	$self->{ua}->request($select);
}

sub user_add{
	my $self = shift;
	my $name = shift;
	my $pass = shift;

	my $areq = POST "https://$self->{host}:8080/ldap-users?ajax=ui-useradd",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ newusername => $name,
		    ];

	my $resp = $self->{ua}->request($areq);
	my %vals = $self->parse_values($resp->{_content});

	my $preq = POST "https://$self->{host}:8080/ldap-users?ajax=ui-usersave",
	    Cookie  =>	"session=$self->{session}",
	    Content => [ user => $name,
		    sn => $name,
		    homedirectory => $vals{homedirectory},
		    loginshell => $vals{loginshell},
		    passwd_1 => $pass,
		    passwd_2 => $pass,
		    ];
	$resp = $self->{ua}->request($preq);
}

sub parse_values{
	my $self = shift;
	my $responce = shift;
	my @responce = split /\n/, $responce;
	map { /update_value\("([^"]*)","([^"]*)"\)/ } @responce;
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Alterator::Automate - Perl extension for automate simple configuration on 
alterator-powered wed server

=head1 SYNOPSIS

  use Alterator::Automate;

  $aa = Alterator::Automate->new($ip);

# auth with password '123'
  $aa->auth('123');
# put ssh key
  $aa->put_key();

=head1 DESCRIPTION

Blah blah blah.

=head1 AUTHOR

Anton V. Boyarshinov, E<lt>boyarsh@altlinux.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 by Anton V. Boyarshinov

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.12.3 or,
at your option, any later version of Perl 5 you may have available.

=cut