DBIx-PgLink

 view release on metacpan or  search on metacpan

Install.html  view on Meta::CPAN

<p>First configuration entry named 'TEST' describe local PostgreSQL connection.
Test will log on to this server as specified user,
drop and create test database and install all database object.</p>
<p><strong>WARNING: all previous content of database will be lost</strong></p>
<p>This database also will be used as 'remote' database for testing.</p>
<p>Other entries are commented by default.</p>
</li>
<li>
<p>Check PostgreSQL account</p>
<p>Ensure that PostgreSQL owner (operating system account, usually 'postgres')
can connect to his own server with specified in t/test.conf credentials.
If used .pgpass file, place it to 'postgres' home directory.</p>
</li>
<li>
<p>Change permission on some directories for PostgreSQL owner account</p>
<dl>
<dt><strong><a name="item_read_permissions_for__2e_2fblib">read permissions for ./blib</a></strong>

<dd>
<pre>
  chmod -R o=r,+X blib</pre>

Usage.html  view on Meta::CPAN

</li>
<dt><strong><a name="item_adapter_class"><em>adapter_class</em> (TEXT)</a></strong>

<dd>
<p>Perl module name for used database, guessed if not specified.</p>
</dd>
</li>
<dt><strong><a name="item_logon_mode"><em>logon_mode</em> (TEXT, mandatory)</a></strong>

<dd>
<p>Tells what credentials are used when no mapping exists
between local PostgreSQL login and remote user</p>
</dd>
<dl>
<dt><strong><a name="item__27empty_27">'empty'</a></strong>

<dd>
<p>Connect with empty user name and empty password</p>
</dd>
</li>
<dt><strong><a name="item__27current_27">'current'</a></strong>

lib/DBIx/PgLink.pm  view on Meta::CPAN

=item *

Parametrized queries

Prevent SQL-injection attack.

=item *

Mapping between database accounts

Can connect with different credentials for each PostgreSQL user.

=item *

Additional functionality for DBI

Such as automatic reconnection after network outage,
nested transactions, charset conversion, prepared statement cache management.


=back

lib/DBIx/PgLink/Connector.pm  view on Meta::CPAN

  is  => 'ro',
  isa => 'Str',
  required => 1,
);

has 'adapter' => (
  is  => 'rw',
  isa => 'DBIx::PgLink::Adapter',
);

has 'credentials' => (
  is  => 'rw',
  isa => 'HashRef',
);

with 'DBIx::PgLink::RoleInstaller';

# functions spread out to fixed roles
with 'DBIx::PgLink::TypeMapper';
with 'DBIx::PgLink::Accessor';
with 'DBIx::PgLink::RemoteAction';

lib/DBIx/PgLink/Connector.pm  view on Meta::CPAN

  # include additional paths
  $self->use_libs( $conn->{use_libs} );

  # apply Connector roles to myself
  $self->load_roles('Connector', $self);

  # check adapter class
  my $adapter_class = $self->require_class($conn->{adapter_class}, "DBIx::PgLink::Adapter");

  # load remote credentials
  $self->credentials( $self->load_credentials($conn->{logon_mode}) )
    or croak "Access to the " . $self->conn_name . " is denied because no login-mapping exists";

  # load attributes
  my $attr_href = $self->load_attributes;

  # pass weak reference to self
  $attr_href->{connector} = $self;
  weaken $attr_href->{connector};

  # create adapter

lib/DBIx/PgLink/Connector.pm  view on Meta::CPAN

  # set role attributes
  # the rest belongs to DBI (and DBI->connect ignore unknown attributes)
  $self->apply_attributes_to_adapter($attr_href);


  return if $self_attr->{no_connect}; # for debugging and connection uninstall

  # connect to remote database
  $self->adapter->connect(
    $conn->{data_source}, 
    $self->credentials->{remote_user}, 
    $self->credentials->{remote_password}, 
    $attr_href
  );
  trace_msg('NOTICE', "Connection " . $self->conn_name . " established to data source $conn->{data_source}" 
    . " as '" . $self->credentials->{remote_user} . "'"
  ) if trace_level>=1;

  return;
}


sub load_connection {
  my $self = shift;
  my $conn = pg_dbh->selectrow_hashref(<<'END_OF_SQL',
SELECT *

lib/DBIx/PgLink/Connector.pm  view on Meta::CPAN

  my $class_prefix = shift;

  $class_name = $class_prefix . "::" . $class_name unless $class_name =~ /::/;
  eval "require $class_name";
  confess "Cannot use class '$class_name' for connection " . $self->conn_name, $@ if $@;

  return $class_name;
}


sub load_credentials {
  my $self = shift;
  my $logon_mode = shift;

  my $cred_sth = pg_dbh->prepare_cached(<<'END_OF_SQL', {no_cursor=>1});
SELECT local_user, remote_user, remote_password
FROM dbix_pglink.users
WHERE conn_name = $1
  and local_user = $2
END_OF_SQL

  my $local_user = pg_dbh->pg_session_user; # session_user because here we in 'security definer' PL/Perl function 
  $cred_sth->execute( $self->conn_name, $local_user );
  my $cred = $cred_sth->fetchrow_hashref;

  # mapping exists
  if ($cred) { 
    trace_msg('NOTICE', "Remote credentials: local user '$local_user' mapped to remote user '$cred->{remote_user}'") 
      if trace_level >= 2;
    return $cred if defined $cred;
  }
  trace_msg('NOTICE', "Remote credentials: no remote user mapping found for local user '$local_user'") 
    if trace_level >= 2;

  return if $logon_mode eq 'deny'; # connection refused

  if ($logon_mode eq 'empty') { 
    # connect with empty user/password
    return { 
      local_user      => '',
      remote_user     => '', 
      remote_password => '',
    };
  } elsif ($logon_mode eq 'current') { 
    # connect as current user without password
    trace_msg('NOTICE', "Remote credentials: with local user name '$local_user' without password") 
      if trace_level >= 2;
    return { 
      local_user      => $local_user,
      remote_user     => $local_user,
      remote_password => '',
    };
  } elsif ($logon_mode eq 'default') { 
    # connect as default user
    my $rc = $cred_sth->execute($self->conn_name, ''); # has empty string as 'local_user'
    my $cred = $cred_sth->fetchrow_hashref;
    if ($cred) {
      trace_msg('NOTICE', "Remote credentials: as default user '$cred->{remote_user}' with default password") 
        if trace_level >= 2;
      return $cred;
    }
  }

  return; # connection refused
}


sub load_attributes {

lib/DBIx/PgLink/Manual/Install.pod  view on Meta::CPAN

This database also will be used as 'remote' database for testing.

Other entries are commented by default.


=item *

Check PostgreSQL account

Ensure that PostgreSQL owner (operating system account, usually 'postgres')
can connect to his own server with specified in t/test.conf credentials.
If used .pgpass file, place it to 'postgres' home directory.


=item *

Change permission on some directories for PostgreSQL owner account

=over

=item read permissions for ./blib

lib/DBIx/PgLink/Manual/Usage.pod  view on Meta::CPAN

=item I<data_source> (TEXT, mandatory)

DBI connection string ('dbi:Driver:params...')

=item I<adapter_class> (TEXT)

Perl module name for used database, guessed if not specified.

=item I<logon_mode> (TEXT, mandatory)

Tells what credentials are used when no mapping exists
between local PostgreSQL login and remote user

=over

=item 'empty'

Connect with empty user name and empty password

=item 'current'

schema.sql  view on Meta::CPAN

  adapter_class d_perl_class_name not null default 'DBIx::PgLink::Adapter',
  logon_mode    d_logon_mode,
  comment       text null,
  use_libs      text[],
  mod_stamp     t_mod_stamp,
  constraint pk_connections primary key (conn_name),
  constraint fk_connections_adapters foreign key (adapter_class) references adapters(adapter_class)
    on update restrict on delete restrict
);
comment on table connections is 
  $$Connection metadata and default login credentials$$;
comment on column connections.conn_name is 
  $$Connection name. Any string.$$;
comment on column connections.data_source is 
  $$Data source name for DBI. Example: 'dbi:Pg:host=127.0.0.1;port=5432;db=postgres'$$;
comment on column connections.adapter_class is 
  $$Subclass of DBIx::PgLink::Adapter that handles connection. Perl class name.$$;
comment on column connections.logon_mode is 
  $$Used when not exist mapping between local and remote login
    'empty' - Connect with empty user name and empty password
    'current' - Connect as current user without password

schema.sql  view on Meta::CPAN

  conn_name       text not null,
  local_user      text not null, -- = session_user | '' for default
  remote_user     text null,
  remote_password text null,
  mod_stamp       t_mod_stamp,
  constraint pk_users primary key (conn_name, local_user),
  constraint fk_users_connections foreign key (conn_name) references connections(conn_name)
    on update cascade  on delete cascade
);
comment on table users is
  $$Mapping between local and remote logins. Default credentials can be added as local_user = '' (empty string).
See comment for connection.logon_mode column$$;

create trigger users_mod_stamp before insert or update
  on users
  for each row execute procedure mod_stamp_trg();


create table data_type_map (
  conn_name       text default '' not null,
  adapter_class   d_perl_class_name not null default 'DBIx::PgLink::Adapter',

t/08cred.t  view on Meta::CPAN

use lib 't';
use PgLinkTestUtil;

my $dbh = PgLinkTestUtil::connect();

PgLinkTestUtil::init_test();


$dbh->do(<<'END_OF_SQL');
create or replace function test_credentials(_conn_name text, _logon_mode d_logon_mode) 
returns text language plperlu security definer as $body$
  my $conn_name = shift;
  my $logon_mode = shift;
  use DBIx::PgLink::Connector;

  my $conn = DBIx::PgLink::Connector->new(conn_name => $conn_name, no_connect=>1);

  my $cred = $conn->load_credentials($logon_mode);
  return $cred->{remote_user};
$body$;
END_OF_SQL

sub cred {
  scalar($dbh->selectrow_array('SELECT test_credentials(?,?)', {}, @_));
}

sub session_user {
  scalar($dbh->selectrow_array('SELECT session_user'));
}

is(session_user(), $Test->{TEST}->{user}, 'session_user is test user');
is(cred('TEST', 'deny'), undef, 'no mapping, strict logon mode');
is(cred('TEST', 'empty'), '', 'no mapping, use empty');
is(cred('TEST', 'current'), $Test->{TEST}->{user}, 'no mapping, use current user');