File manager

File manager - Edit - /home/c14075/dragmet-ural.ru/www/DbDriver.tar

Back
Backup.pm��0000644��00000003146�15142275066�0006323 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Backup; use strict; use Debconf::Log qw{:all}; use base 'Debconf::DbDriver::Copy'; use fields qw(db backupdb); sub init { my $this=shift; foreach my $f (qw(db backupdb)) { if (! ref $this->{$f}) { my $db=$this->driver($this->{$f}); unless (defined $f) { $this->error("could not find a db named \"$this->{$f}\""); } $this->{$f}=$db; } } } sub copy { my $this=shift; my $item=shift; $this->SUPER::copy($item, $this->{db}, $this->{backupdb}); } sub shutdown { my $this=shift; $this->{backupdb}->shutdown(@_); $this->{db}->shutdown(@_); } sub _query { my $this=shift; my $command=shift; shift; # this again return $this->{db}->$command(@_); } sub _change { my $this=shift; my $command=shift; shift; # this again my $ret=$this->{db}->$command(@_); if (defined $ret) { $this->{backupdb}->$command(@_); } return $ret; } sub iterator { $_[0]->_query('iterator', @_) } sub exists { $_[0]->_query('exists', @_) } sub addowner { $_[0]->_change('addowner', @_) } sub removeowner { $_[0]->_change('removeowner', @_) } sub owners { $_[0]->_query('owners', @_) } sub getfield { $_[0]->_query('getfield', @_) } sub setfield { $_[0]->_change('setfield', @_) } sub fields { $_[0]->_query('fields', @_) } sub getflag { $_[0]->_query('getflag', @_) } sub setflag { $_[0]->_change('setflag', @_) } sub flags { $_[0]->_query('flags', @_) } sub getvariable { $_[0]->_query('getvariable', @_) } sub setvariable { $_[0]->_change('setvariable', @_) } sub variables { $_[0]->_query('variables', @_) } 1 ��Stack.pm��0000644��00000012210�15142275066�0006153 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Stack; use strict; use Debconf::Log qw{:all}; use Debconf::Iterator; use base 'Debconf::DbDriver::Copy'; use fields qw(stack stack_change_errors); sub init { my $this=shift; if (! ref $this->{stack}) { my @stack; foreach my $name (split(/\s,\s/, $this->{stack})) { my $driver=$this->driver($name); unless (defined $driver) { $this->error("could not find a db named \"$name\" to use in the stack (it should be defined before the stack in the config file)"); next; } push @stack, $driver; } $this->{stack}=[@stack]; } $this->error("no stack set") if ! ref $this->{stack}; $this->error("stack is empty") if ! @{$this->{stack}}; } sub iterator { my $this=shift; my %seen; my @iterators = map { $_->iterator } @{$this->{stack}}; my $i = pop @iterators; my $iterator=Debconf::Iterator->new(callback => sub { for (;;) { while (my $ret = $i->iterate) { next if $seen{$ret}; $seen{$ret}=1; return $ret; } $i = pop @iterators; return undef unless defined $i; } }); } sub shutdown { my $this=shift; my $ret=1; foreach my $driver (@{$this->{stack}}) { $ret=undef if not defined $driver->shutdown(@_); } if ($this->{stack_change_errors}) { $this->error("unable to save changes to: ". join(" ", @{$this->{stack_change_errors}})); $ret=undef; } return $ret; } sub exists { my $this=shift; foreach my $driver (@{$this->{stack}}) { return 1 if $driver->exists(@_); } return 0; } sub _query { my $this=shift; my $command=shift; shift; # this again debug "db $this->{name}" => "trying to $command(@_) .."; foreach my $driver (@{$this->{stack}}) { if (wantarray) { my @ret=$driver->$command(@_); debug "db $this->{name}" => "$command done by $driver->{name}" if @ret; return @ret if @ret; } else { my $ret=$driver->$command(@_); debug "db $this->{name}" => "$command done by $driver->{name}" if defined $ret; return $ret if defined $ret; } } return; # failure } sub _change { my $this=shift; my $command=shift; shift; # this again my $item=shift; debug "db $this->{name}" => "trying to $command($item @_) .."; foreach my $driver (@{$this->{stack}}) { if ($driver->exists($item)) { last if $driver->{readonly}; # nope, hit a readonly one debug "db $this->{name}" => "passing to $driver->{name} .."; return $driver->$command($item, @_); } } my $src=0; foreach my $driver (@{$this->{stack}}) { if ($driver->exists($item)) { my $ret=$this->_nochange($driver, $command, $item, @_); if (defined $ret) { debug "db $this->{name}" => "skipped $command($item) as it would have no effect"; return $ret; } $src=$driver; last } } my $writer; foreach my $driver (@{$this->{stack}}) { if ($driver == $src) { push @{$this->{stack_change_errors}}, $item; return; } if (! $driver->{readonly}) { if ($command eq 'addowner') { if ($driver->accept($item, $_[1])) { $writer=$driver; last; } } elsif ($driver->accept($item)) { $writer=$driver; last; } } } unless ($writer) { debug "db $this->{name}" => "FAILED $command"; return; } if ($src) { $this->copy($item, $src, $writer); } debug "db $this->{name}" => "passing to $writer->{name} .."; return $writer->$command($item, @_); } sub _nochange { my $this=shift; my $driver=shift; my $command=shift; my $item=shift; if ($command eq 'addowner') { my $value=shift; foreach my $owner ($driver->owners($item)) { return $value if $owner eq $value; } return; } elsif ($command eq 'removeowner') { my $value=shift; foreach my $owner ($driver->owners($item)) { return if $owner eq $value; } return $value; # no change } elsif ($command eq 'removefield') { my $value=shift; foreach my $field ($driver->fields($item)) { return if $field eq $value; } return $value; # no change } my @list; my $get; if ($command eq 'setfield') { @list=$driver->fields($item); $get='getfield'; } elsif ($command eq 'setflag') { @list=$driver->flags($item); $get='getflag'; } elsif ($command eq 'setvariable') { @list=$driver->variables($item); $get='getvariable'; } else { $this->error("internal error; bad command: $command"); } my $thing=shift; my $value=shift; my $currentvalue=$driver->$get($item, $thing); my $exists=0; foreach my $i (@list) { $exists=1, last if $thing eq $i; } return $currentvalue unless $exists; return $currentvalue if $currentvalue eq $value; return undef; } sub addowner { $_[0]->_change('addowner', @_) } sub removeowner { $_[0]->_change('removeowner', @_) } sub owners { $_[0]->_query('owners', @_) } sub getfield { $_[0]->_query('getfield', @_) } sub setfield { $_[0]->_change('setfield', @_) } sub removefield { $_[0]->_change('removefield', @_) } sub fields { $_[0]->_query('fields', @_) } sub getflag { $_[0]->_query('getflag', @_) } sub setflag { $_[0]->_change('setflag', @_) } sub flags { $_[0]->_query('flags', @_) } sub getvariable { $_[0]->_query('getvariable', @_) } sub setvariable { $_[0]->_change('setvariable', @_) } sub variables { $_[0]->_query('variables', @_) } 1 ��Debug.pm��0000644��00000001666�15142275066�0006151 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Debug; use strict; use Debconf::Log qw{:all}; use base 'Debconf::DbDriver'; use fields qw(db); sub init { my $this=shift; if (! ref $this->{db}) { $this->{db}=$this->driver($this->{db}); unless (defined $this->{db}) { $this->error("could not find db"); } } } sub DESTROY {} sub AUTOLOAD { my $this=shift; (my $command = our $AUTOLOAD) =~ s/.://; debug "db $this->{name}" => "running $command(".join(",", map { "'$_'" } @_).") .."; if (wantarray) { my @ret=$this->{db}->$command(@_); debug "db $this->{name}" => "$command returned (".join(", ", @ret).")"; return @ret if @ret; } else { my $ret=$this->{db}->$command(@_); if (defined $ret) { debug "db $this->{name}" => "$command returned \'$ret\'"; return $ret; } else { debug "db $this->{name}" => "$command returned undef"; } } return; # failure } 1 ��Directory.pm��0000644��00000007031�15142275066�0007057 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Directory; use strict; use Debconf::Log qw(:all); use IO::File; use POSIX (); use Fcntl qw(:DEFAULT :flock); use Debconf::Iterator; use base 'Debconf::DbDriver::Cache'; use fields qw(directory extension lock format); sub init { my $this=shift; $this->{extension} = "" unless exists $this->{extension}; $this->{format} = "822" unless exists $this->{format}; $this->{backup} = 1 unless exists $this->{backup}; $this->error("No format specified") unless $this->{format}; eval "use Debconf::Format::$this->{format}"; if ($@) { $this->error("Error setting up format object $this->{format}: $@"); } $this->{format}="Debconf::Format::$this->{format}"->new; if (not ref $this->{format}) { $this->error("Unable to make format object"); } $this->error("No directory specified") unless $this->{directory}; if (not -d $this->{directory} and not $this->{readonly}) { mkdir $this->{directory} \|\| $this->error("mkdir $this->{directory}:$!"); } if (not -d $this->{directory}) { $this->error($this->{directory}." does not exist"); } debug "db $this->{name}" => "started; directory is $this->{directory}"; if (! $this->{readonly}) { open ($this->{lock}, ">".$this->{directory}."/.lock") or $this->error("could not lock $this->{directory}: $!"); while (! flock($this->{lock}, LOCK_EX \| LOCK_NB)) { next if $! == &POSIX::EINTR; $this->error("$this->{directory} is locked by another process: $!"); last; } } } sub load { my $this=shift; my $item=shift; debug "db $this->{name}" => "loading $item"; my $file=$this->{directory}.'/'.$this->filename($item); return unless -e $file; my $fh=IO::File->new; open($fh, $file) or $this->error("$file: $!"); $this->cacheadd($this->{format}->read($fh)); close $fh; } sub save { my $this=shift; my $item=shift; my $data=shift; return unless $this->accept($item); return if $this->{readonly}; debug "db $this->{name}" => "saving $item"; my $file=$this->{directory}.'/'.$this->filename($item); my $fh=IO::File->new; if ($this->ispassword($item)) { sysopen($fh, $file."-new", O_WRONLY\|O_TRUNC\|O_CREAT, 0600) or $this->error("$file-new: $!"); } else { open($fh, ">$file-new") or $this->error("$file-new: $!"); } $this->{format}->beginfile; $this->{format}->write($fh, $data, $item) or $this->error("could not write $file-new: $!"); $this->{format}->endfile; $fh->flush or $this->error("could not flush $file-new: $!"); $fh->sync or $this->error("could not sync $file-new: $!"); close $fh or $this->error("could not close $file-new: $!"); if (-e $file && $this->{backup}) { rename($file, $file."-old") or debug "db $this->{name}" => "rename failed: $!"; } rename("$file-new", $file) or $this->error("rename failed: $!"); } sub shutdown { my $this=shift; $this->SUPER::shutdown(@_); delete $this->{lock}; return 1; } sub exists { my $this=shift; my $name=shift; my $incache=$this->SUPER::exists($name); return $incache if (!defined $incache or $incache); return -e $this->{directory}.'/'.$this->filename($name); } sub remove { my $this=shift; my $name=shift; return if $this->{readonly} or not $this->accept($name); debug "db $this->{name}" => "removing $name"; my $file=$this->{directory}.'/'.$this->filename($name); unlink $file or return undef; if (-e $file."-old") { unlink $file."-old" or return undef; } return 1; } sub accept { my $this=shift; my $name=shift; return if $name=~m#\.\./# or $name=~m#/\.\.#; $this->SUPER::accept($name, @_); } 1 ��Cache.pm��0000644��00000011331�15142275066�0006114 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Cache; use strict; use Debconf::Log qw{:all}; use base 'Debconf::DbDriver'; use fields qw(cache dirty); sub iterator { my $this=shift; my $subiterator=shift; my @items=keys %{$this->{cache}}; my $iterator=Debconf::Iterator->new(callback => sub { while (my $item = pop @items) { next unless defined $this->{cache}->{$item}; return $item; } return unless $subiterator; my $ret; do { $ret=$subiterator->iterate; } while defined $ret and exists $this->{cache}->{$ret}; return $ret; }); return $iterator; } sub exists { my $this=shift; my $item=shift; return $this->{cache}->{$item} if exists $this->{cache}->{$item}; return 0; } sub init { my $this=shift; $this->{cache} = {} unless exists $this->{cache}; } sub cacheadd { my $this=shift; my $item=shift; my $entry=shift; return if exists $this->{cache}->{$item}; $this->{cache}->{$item}=$entry; $this->{dirty}->{$item}=0; } sub cachedata { my $this=shift; my $item=shift; return $this->{cache}->{$item}; } sub cached { my $this=shift; my $item=shift; unless (exists $this->{cache}->{$item}) { debug "db $this->{name}" => "cache miss on $item"; $this->load($item); } return $this->{cache}->{$item}; } sub shutdown { my $this=shift; return if $this->{readonly}; my $ret=1; foreach my $item (keys %{$this->{cache}}) { if (not defined $this->{cache}->{$item}) { $ret=undef unless defined $this->remove($item); delete $this->{cache}->{$item}; } elsif ($this->{dirty}->{$item}) { $ret=undef unless defined $this->save($item, $this->{cache}->{$item}); $this->{dirty}->{$item}=0; } } return $ret; } sub addowner { my $this=shift; my $item=shift; my $owner=shift; my $type=shift; return if $this->{readonly}; $this->cached($item); if (! defined $this->{cache}->{$item}) { return if ! $this->accept($item, $type); debug "db $this->{name}" => "creating in-cache $item"; $this->{cache}->{$item}={ owners => {}, fields => {}, variables => {}, flags => {}, } } if (! exists $this->{cache}->{$item}->{owners}->{$owner}) { $this->{cache}->{$item}->{owners}->{$owner}=1; $this->{dirty}->{$item}=1; } return $owner; } sub removeowner { my $this=shift; my $item=shift; my $owner=shift; return if $this->{readonly}; return unless $this->cached($item); if (exists $this->{cache}->{$item}->{owners}->{$owner}) { delete $this->{cache}->{$item}->{owners}->{$owner}; $this->{dirty}->{$item}=1; } unless (keys %{$this->{cache}->{$item}->{owners}}) { $this->{cache}->{$item}=undef; $this->{dirty}->{$item}=1; } return $owner; } sub owners { my $this=shift; my $item=shift; return unless $this->cached($item); return keys %{$this->{cache}->{$item}->{owners}}; } sub getfield { my $this=shift; my $item=shift; my $field=shift; return unless $this->cached($item); return $this->{cache}->{$item}->{fields}->{$field}; } sub setfield { my $this=shift; my $item=shift; my $field=shift; my $value=shift; return if $this->{readonly}; return unless $this->cached($item); $this->{dirty}->{$item}=1; return $this->{cache}->{$item}->{fields}->{$field} = $value; } sub removefield { my $this=shift; my $item=shift; my $field=shift; return if $this->{readonly}; return unless $this->cached($item); $this->{dirty}->{$item}=1; return delete $this->{cache}->{$item}->{fields}->{$field}; } sub fields { my $this=shift; my $item=shift; return unless $this->cached($item); return keys %{$this->{cache}->{$item}->{fields}}; } sub getflag { my $this=shift; my $item=shift; my $flag=shift; return unless $this->cached($item); return $this->{cache}->{$item}->{flags}->{$flag} if exists $this->{cache}->{$item}->{flags}->{$flag}; return 'false'; } sub setflag { my $this=shift; my $item=shift; my $flag=shift; my $value=shift; return if $this->{readonly}; return unless $this->cached($item); $this->{dirty}->{$item}=1; return $this->{cache}->{$item}->{flags}->{$flag} = $value; } sub flags { my $this=shift; my $item=shift; return unless $this->cached($item); return keys %{$this->{cache}->{$item}->{flags}}; } sub getvariable { my $this=shift; my $item=shift; my $variable=shift; return unless $this->cached($item); return $this->{cache}->{$item}->{variables}->{$variable}; } sub setvariable { my $this=shift; my $item=shift; my $variable=shift; my $value=shift; return if $this->{readonly}; return unless $this->cached($item); $this->{dirty}->{$item}=1; return $this->{cache}->{$item}->{variables}->{$variable} = $value; } sub variables { my $this=shift; my $item=shift; return unless $this->cached($item); return keys %{$this->{cache}->{$item}->{variables}}; } 1 ��File.pm��0000644��00000007061�15142275066�0005775 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::File; use strict; use Debconf::Log qw(:all); use Cwd 'abs_path'; use POSIX (); use Fcntl qw(:DEFAULT :flock); use IO::Handle; use base 'Debconf::DbDriver::Cache'; use fields qw(filename mode format _fh); sub init { my $this=shift; if (exists $this->{mode}) { $this->{mode} = oct($this->{mode}); } else { $this->{mode} = 0600; } $this->{format} = "822" unless exists $this->{format}; $this->{backup} = 1 unless exists $this->{backup}; $this->error("No format specified") unless $this->{format}; eval "use Debconf::Format::$this->{format}"; if ($@) { $this->error("Error setting up format object $this->{format}: $@"); } $this->{format}="Debconf::Format::$this->{format}"->new; if (not ref $this->{format}) { $this->error("Unable to make format object"); } $this->error("No filename specified") unless $this->{filename}; my ($directory)=$this->{filename}=~m!^(.)/[^/]+!; if (length $directory and ! -d $directory) { mkdir $directory \|\| $this->error("mkdir $directory:$!"); } $this->{filename} = abs_path($this->{filename}); debug "db $this->{name}" => "started; filename is $this->{filename}"; if (! -e $this->{filename}) { $this->{backup}=0; sysopen(my $fh, $this->{filename}, O_WRONLY\|O_TRUNC\|O_CREAT,$this->{mode}) or $this->error("could not open $this->{filename}"); close $fh; } my $implicit_readonly=0; if (! $this->{readonly}) { if (open ($this->{_fh}, "+<", $this->{filename})) { while (! flock($this->{_fh}, LOCK_EX \| LOCK_NB)) { next if $! == &POSIX::EINTR; $this->error("$this->{filename} is locked by another process: $!"); last; } } else { $implicit_readonly=1; } } if ($this->{readonly} \|\| $implicit_readonly) { if (! open ($this->{_fh}, "<", $this->{filename})) { $this->error("could not open $this->{filename}: $!"); return; # always abort, even if not throwing fatal error } } $this->SUPER::init(@_); debug "db $this->{name}" => "loading database"; while (! eof $this->{_fh}) { my ($item, $cache)=$this->{format}->read($this->{_fh}); $this->{cache}->{$item}=$cache; } if ($this->{readonly} \|\| $implicit_readonly) { close $this->{_fh}; } } sub shutdown { my $this=shift; return if $this->{readonly}; if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) { debug "db $this->{name}" => "saving database"; } else { debug "db $this->{name}" => "no database changes, not saving"; delete $this->{_fh}; return 1; } sysopen(my $fh, $this->{filename}."-new", O_WRONLY\|O_TRUNC\|O_CREAT,$this->{mode}) or $this->error("could not write $this->{filename}-new: $!"); while (! flock($fh, LOCK_EX \| LOCK_NB)) { next if $! == &POSIX::EINTR; $this->error("$this->{filename}-new is locked by another process: $!"); last; } $this->{format}->beginfile; foreach my $item (sort keys %{$this->{cache}}) { next unless defined $this->{cache}->{$item}; # skip deleted $this->{format}->write($fh, $this->{cache}->{$item}, $item) or $this->error("could not write $this->{filename}-new: $!"); } $this->{format}->endfile; $fh->flush or $this->error("could not flush $this->{filename}-new: $!"); $fh->sync or $this->error("could not sync $this->{filename}-new: $!"); if (-e $this->{filename} && $this->{backup}) { rename($this->{filename}, $this->{filename}."-old") or debug "db $this->{name}" => "rename failed: $!"; } rename($this->{filename}."-new", $this->{filename}) or $this->error("rename failed: $!"); delete $this->{_fh}; return 1; } sub load { return undef; } 1 ��LDAP.pm��0000644��00000014122�15142275066�0005632 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::LDAP; use strict; use Debconf::Log qw(:all); use Net::LDAP; use base 'Debconf::DbDriver::Cache'; use fields qw(server port basedn binddn bindpasswd exists keybykey ds accept_attribute reject_attribute); sub binddb { my $this=shift; $this->error("No server specified") unless exists $this->{server}; $this->error("No Base DN specified") unless exists $this->{basedn}; $this->{binddn} = "" unless exists $this->{binddn}; $this->{port} = 389 unless exists $this->{port}; debug "db $this->{name}" => "talking to $this->{server}, data under $this->{basedn}"; $this->{ds} = Net::LDAP->new($this->{server}, port => $this->{port}, version => 3); if (! $this->{ds}) { $this->error("Unable to connect to LDAP server"); return; # if not fatal, give up anyway } my $rv = ""; if (!($this->{binddn} && $this->{bindpasswd})) { debug "db $this->{name}" => "binding anonymously; hope that's OK"; $rv = $this->{ds}->bind; } else { debug "db $this->{name}" => "binding as $this->{binddn}"; $rv = $this->{ds}->bind($this->{binddn}, password => $this->{bindpasswd}); } if ($rv->code) { $this->error("Bind Failed: ".$rv->error); } return $this->{ds}; } sub init { my $this = shift; $this->SUPER::init(@_); $this->binddb; return unless $this->{ds}; $this->{exists} = {}; if ($this->{keybykey}) { debug "db $this->{name}" => "will get database data key by key"; } else { debug "db $this->{name}" => "getting database data"; my $data = $this->{ds}->search(base => $this->{basedn}, sizelimit => 0, timelimit => 0, filter => "(objectclass=debconfDbEntry)"); if ($data->code) { $this->error("Search failed: ".$data->error); } my $records = $data->as_struct(); debug "db $this->{name}" => "Read ".$data->count()." entries"; $this->parse_records($records); $this->{ds}->unbind; } } sub shutdown { my $this = shift; return if $this->{readonly}; if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) { debug "db $this->{name}" => "saving changes"; } else { debug "db $this->{name}" => "no database changes, not saving"; return 1; } unless ($this->{keybykey}) { $this->binddb; return unless $this->{ds}; } foreach my $item (keys %{$this->{cache}}) { next unless defined $this->{cache}->{$item}; # skip deleted next unless $this->{dirty}->{$item}; # skip unchanged (my $entry_cn = $item) =~ s/([,+="<>#;])/\\$1/g; my $entry_dn = "cn=$entry_cn,$this->{basedn}"; debug "db $this->{name}" => "writing out to $entry_dn"; my %data = %{$this->{cache}->{$item}}; my %modify_data; my $add_data = [ 'objectclass' => 'top', 'objectclass' => 'debconfdbentry', 'cn' => $item ]; my @fields = keys %{$data{fields}}; foreach my $field (@fields) { my $ldapname = $field; if ( $ldapname =~ s/_(\w)/uc($1)/ge ) { $data{fields}->{$ldapname} = $data{fields}->{$field}; delete $data{fields}->{$field}; } } foreach my $field (keys %{$data{fields}}) { next if ($data{fields}->{$field} eq '' && !($field eq 'value')); if ((exists $this->{accept_attribute} && $field !~ /$this->{accept_attribute}/) or (exists $this->{reject_attribute} && $field =~ /$this->{reject_attribute}/)) { debug "db $item" => "reject $field"; next; } $modify_data{$field}=$data{fields}->{$field}; push(@{$add_data}, $field); push(@{$add_data}, $data{fields}->{$field}); } my @owners = keys %{$data{owners}}; debug "db $this->{name}" => "owners is ".join(" ", @owners); $modify_data{owners} = \@owners; push(@{$add_data}, 'owners'); push(@{$add_data}, \@owners); my @flags = grep { $data{flags}->{$_} eq 'true' } keys %{$data{flags}}; if (@flags) { $modify_data{flags} = \@flags; push(@{$add_data}, 'flags'); push(@{$add_data}, \@flags); } $modify_data{variables} = []; foreach my $var (keys %{$data{variables}}) { my $variable = "$var=$data{variables}->{$var}"; push (@{$modify_data{variables}}, $variable); push(@{$add_data}, 'variables'); push(@{$add_data}, $variable); } my $rv=""; if ($this->{exists}->{$item}) { $rv = $this->{ds}->modify($entry_dn, replace => \%modify_data); } else { $rv = $this->{ds}->add($entry_dn, attrs => $add_data); } if ($rv->code) { $this->error("Modify failed: ".$rv->error); } } $this->{ds}->unbind(); $this->SUPER::shutdown(@_); } sub load { my $this = shift; return unless $this->{keybykey}; my $entry_cn = shift; my $records = $this->get_key($entry_cn); return unless $records; debug "db $this->{name}" => "Read entry for $entry_cn"; $this->parse_records($records); } sub remove { return 1; } sub save { return 1; } sub get_key { my $this = shift; return unless $this->{keybykey}; my $entry_cn = shift; my $data = $this->{ds}->search( base => 'cn=' . $entry_cn . ',' . $this->{basedn}, sizelimit => 0, timelimit => 0, filter => "(objectclass=debconfDbEntry)"); if ($data->code) { $this->error("Search failed: ".$data->error); } return unless $data->entries; $data->as_struct(); } sub parse_records { my $this = shift; my $records = shift; foreach my $dn (keys %{$records}) { my $entry = $records->{$dn}; debug "db $this->{name}" => "Reading data from $dn"; my %ret = (owners => {}, fields => {}, variables => {}, flags => {}, ); my $name = ""; foreach my $attr (keys %{$entry}) { if ($attr eq 'objectclass') { next; } my $values = $entry->{$attr}; $attr =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge; debug "db $this->{name}" => "Setting data for $attr"; foreach my $val (@{$values}) { debug "db $this->{name}" => "$attr = $val"; if ($attr eq 'owners') { $ret{owners}->{$val}=1; } elsif ($attr eq 'flags') { $ret{flags}->{$val}='true'; } elsif ($attr eq 'cn') { $name = $val; } elsif ($attr eq 'variables') { my ($var, $value)=split(/\s=\s/, $val, 2); $ret{variables}->{$var}=$value; } else { $val=~s/\\n/\n/g; $ret{fields}->{$attr}=$val; } } } $this->{cache}->{$name} = \%ret; $this->{exists}->{$name} = 1; } } 1 ��DirTree.pm��0000644��00000003706�15142275066�0006456 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::DirTree; use strict; use Debconf::Log qw(:all); use base 'Debconf::DbDriver::Directory'; sub init { my $this=shift; if (! defined $this->{extension} or ! length $this->{extension}) { $this->{extension}=".dat"; } $this->SUPER::init(@_); } sub save { my $this=shift; my $item=shift; return unless $this->accept($item); return if $this->{readonly}; my @dirs=split(m:/:, $this->filename($item)); pop @dirs; # the base filename my $base=$this->{directory}; foreach (@dirs) { $base.="/$_"; next if -d $base; mkdir $base or $this->error("mkdir $base: $!"); } $this->SUPER::save($item, @_); } sub filename { my $this=shift; my $item=shift; $item =~ s/\.\.//g; return $item.$this->{extension}; } sub iterator { my $this=shift; my @stack=(); my $currentdir=""; my $handle; opendir($handle, $this->{directory}) or $this->error("opendir: $this->{directory}: $!"); my $iterator=Debconf::Iterator->new(callback => sub { my $i; while ($handle or @stack) { while (@stack and not $handle) { $currentdir=pop @stack; opendir($handle, "$this->{directory}/$currentdir") or $this->error("opendir: $this->{directory}/$currentdir: $!"); } $i=readdir($handle); if (not defined $i) { closedir $handle; $handle=undef; next; } next if $i eq '.lock' \|\| $i =~ /-old$/; if (-d "$this->{directory}/$currentdir$i") { if ($i ne '..' and $i ne '.') { push @stack, "$currentdir$i/"; } next; } next unless $i=~s/$this->{extension}$//; return $currentdir.$i; } return undef; }); $this->SUPER::iterator($iterator); } sub remove { my $this=shift; my $item=shift; my $ret=$this->SUPER::remove($item); return $ret unless $ret; my $dir=$this->filename($item); while ($dir=~s:(.)/[^/]*:$1: and length $dir) { rmdir "$this->{directory}/$dir" or last; # not empty, I presume } return $ret; } 1 ��PackageDir.pm��0000644��00000007127�15142275066�0007113 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::PackageDir; use strict; use Debconf::Log qw(:all); use IO::File; use Fcntl qw(:DEFAULT :flock); use Debconf::Iterator; use base 'Debconf::DbDriver::Directory'; use fields qw(mode _loaded); sub init { my $this=shift; if (exists $this->{mode}) { $this->{mode} = oct($this->{mode}); } else { $this->{mode} = 0600; } $this->SUPER::init(@_); } sub loadfile { my $this=shift; my $file=$this->{directory}."/".shift; return if $this->{_loaded}->{$file}; $this->{_loaded}->{$file}=1; debug "db $this->{name}" => "loading $file"; return unless -e $file; my $fh=IO::File->new; open($fh, $file) or $this->error("$file: $!"); my @item = $this->{format}->read($fh); while (@item) { $this->cacheadd(@item); @item = $this->{format}->read($fh); } close $fh; } sub load { my $this=shift; my $item=shift; $this->loadfile($this->filename($item)); } sub filename { my $this=shift; my $item=shift; if ($item =~ m!^([^/]+)(?:/\|$)!) { return $1.$this->{extension}; } else { $this->error("failed parsing item name \"$item\"\n"); } } sub iterator { my $this=shift; my $handle; opendir($handle, $this->{directory}) \|\| $this->error("opendir: $!"); while (my $file=readdir($handle)) { next if length $this->{extension} and not $file=~m/$this->{extension}/; next unless -f $this->{directory}."/".$file; next if $file eq '.lock' \|\| $file =~ /-old$/; $this->loadfile($file); } $this->SUPER::iterator; } sub exists { my $this=shift; my $name=shift; my $incache=$this->Debconf::DbDriver::Cache::exists($name); return $incache if (!defined $incache or $incache); my $file=$this->{directory}.'/'.$this->filename($name); return unless -e $file; $this->load($name); return $this->Debconf::DbDriver::Cache::exists($name); } sub shutdown { my $this=shift; return if $this->{readonly}; my (%files, %filecontents, %killfiles, %dirtyfiles); foreach my $item (keys %{$this->{cache}}) { my $file=$this->filename($item); $files{$file}++; if (! defined $this->{cache}->{$item}) { $killfiles{$file}++; delete $this->{cache}->{$item}; } else { push @{$filecontents{$file}}, $item; } if ($this->{dirty}->{$item}) { $dirtyfiles{$file}++; $this->{dirty}->{$item}=0; } } foreach my $file (keys %files) { if (! $filecontents{$file} && $killfiles{$file}) { debug "db $this->{name}" => "removing $file"; my $filename=$this->{directory}."/".$file; unlink $filename or $this->error("unable to remove $filename: $!"); if (-e $filename."-old") { unlink $filename."-old" or $this->error("unable to remove $filename-old: $!"); } } elsif ($dirtyfiles{$file}) { debug "db $this->{name}" => "saving $file"; my $filename=$this->{directory}."/".$file; sysopen(my $fh, $filename."-new", O_WRONLY\|O_TRUNC\|O_CREAT,$this->{mode}) or $this->error("could not write $filename-new: $!"); $this->{format}->beginfile; foreach my $item (@{$filecontents{$file}}) { $this->{format}->write($fh, $this->{cache}->{$item}, $item) or $this->error("could not write $filename-new: $!"); } $this->{format}->endfile; $fh->flush or $this->error("could not flush $filename-new: $!"); $fh->sync or $this->error("could not sync $filename-new: $!"); if (-e $filename && $this->{backup}) { rename($filename, $filename."-old") or debug "db $this->{name}" => "rename failed: $!"; } rename($filename."-new", $filename) or $this->error("rename failed: $!"); } } $this->SUPER::shutdown(@_); return 1; } 1 ��Pipe.pm��0000644��00000003367�15142275066�0006020 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Pipe; use strict; use Debconf::Log qw(:all); use base 'Debconf::DbDriver::Cache'; use fields qw(infd outfd format); sub init { my $this=shift; $this->{format} = "822" unless exists $this->{format}; $this->error("No format specified") unless $this->{format}; eval "use Debconf::Format::$this->{format}"; if ($@) { $this->error("Error setting up format object $this->{format}: $@"); } $this->{format}="Debconf::Format::$this->{format}"->new; if (not ref $this->{format}) { $this->error("Unable to make format object"); } my $fh; if (defined $this->{infd}) { if ($this->{infd} ne 'none') { open ($fh, "<&=$this->{infd}") or $this->error("could not open file descriptor #$this->{infd}: $!"); } } else { open ($fh, '-'); } $this->SUPER::init(@_); debug "db $this->{name}" => "loading database"; if (defined $fh) { while (! eof $fh) { my ($item, $cache)=$this->{format}->read($fh); $this->{cache}->{$item}=$cache; } close $fh; } } sub shutdown { my $this=shift; return if $this->{readonly}; my $fh; if (defined $this->{outfd}) { if ($this->{outfd} ne 'none') { open ($fh, ">&=$this->{outfd}") or $this->error("could not open file descriptor #$this->{outfd}: $!"); } } else { open ($fh, '>-'); } if (defined $fh) { $this->{format}->beginfile; foreach my $item (sort keys %{$this->{cache}}) { next unless defined $this->{cache}->{$item}; # skip deleted $this->{format}->write($fh, $this->{cache}->{$item}, $item) or $this->error("could not write to pipe: $!"); } $this->{format}->endfile; close $fh or $this->error("could not close pipe: $!"); } return 1; } sub load { return undef; } 1 ��Copy.pm��0000644��00000001666�15142275066�0006035 0��ustar�00��#!/usr/bin/perl -w # This file was preprocessed, do not edit! package Debconf::DbDriver::Copy; use strict; use Debconf::Log qw{:all}; use base 'Debconf::DbDriver'; sub copy { my $this=shift; my $item=shift; my $src=shift; my $dest=shift; debug "db $this->{name}" => "copying $item from $src->{name} to $dest->{name}"; my @owners=$src->owners($item); if (! @owners) { @owners=("unknown"); } foreach my $owner (@owners) { my $template = Debconf::Template->get($src->getfield($item, 'template')); my $type=""; $type = $template->type if $template; $dest->addowner($item, $owner, $type); } foreach my $field ($src->fields($item)) { $dest->setfield($item, $field, $src->getfield($item, $field)); } foreach my $flag ($src->flags($item)) { $dest->setflag($item, $flag, $src->getflag($item, $flag)); } foreach my $var ($src->variables($item)) { $dest->setvariable($item, $var, $src->getvariable($item, $var)); } } 1 ��

| ver. 1.4 | Github | . | PHP 7.4.33 | Generation time: 0.25 | proxy | phpinfo | Settings