From 0ca0676e9716808a09be85944165cd49607afc3c Mon Sep 17 00:00:00 2001 From: Vsevolod Stakhov Date: Sun, 15 Dec 2013 23:45:53 +0400 Subject: [PATCH] Remove deprecated perl module. --- perl/MANIFEST | 3 - perl/Makefile.PL.in | 11 - perl/lib/Mail/Rspamd/Client.pm | 1390 -------------------------------- perl/lib/Mail/Rspamd/Config.pm | 593 -------------- 4 files changed, 1997 deletions(-) delete mode 100644 perl/MANIFEST delete mode 100644 perl/Makefile.PL.in delete mode 100644 perl/lib/Mail/Rspamd/Client.pm delete mode 100644 perl/lib/Mail/Rspamd/Config.pm diff --git a/perl/MANIFEST b/perl/MANIFEST deleted file mode 100644 index 49ff80978..000000000 --- a/perl/MANIFEST +++ /dev/null @@ -1,3 +0,0 @@ -Makefile.PL -MANIFEST -lib/Mail/Rspamd/Client.pm diff --git a/perl/Makefile.PL.in b/perl/Makefile.PL.in deleted file mode 100644 index 625e69310..000000000 --- a/perl/Makefile.PL.in +++ /dev/null @@ -1,11 +0,0 @@ -use ExtUtils::MakeMaker; -WriteMakefile( - AUTHOR => 'Vsevolod Stakhov ', - VERSION_FROM => 'lib/Mail/Rspamd/Client.pm', # finds $VERSION - PREREQ_PM => { - "IO::String" => 0, - "Term::ReadKey" => 0, - "XML::Parser" => 0, - "IO::Socket" => 0, - }, - ); diff --git a/perl/lib/Mail/Rspamd/Client.pm b/perl/lib/Mail/Rspamd/Client.pm deleted file mode 100644 index 9353c2468..000000000 --- a/perl/lib/Mail/Rspamd/Client.pm +++ /dev/null @@ -1,1390 +0,0 @@ - -=head1 NAME - -Mail::Rspamd::Client - Client for rspamd Protocol - - -=head1 SYNOPSIS - - my $client = new Mail::Rspamd::Client($config); - - if ($client->ping()) { - $self->{error} = "Ping is ok\n"; - } - - my $result = $client->check($testmsg); - - if ($result->{'default'}->{isspam} eq 'True') { - do something with spam message here - } - -=head1 DESCRIPTION - -Mail::Rspamd::Client is a module that provides a perl implementation for -the spamd protocol. - -=cut - -package Mail::Rspamd::Client; - -use IO::Socket; -use Carp; - -use vars qw($VERSION); -$VERSION = "1.02"; - -my $EOL = "\015\012"; -my $BLANK = $EOL x 2; -my $PROTOVERSION = 'RSPAMC/1.2'; - -=head1 PUBLIC METHODS - -=head2 new - -public class (Mail::Rspamd::Client) new (\% $args) - -Description: -This method creates a new Mail::Rspamd::Client object. - -=cut - -sub new { - my ($class, $args) = @_; - - $class = ref($class) || $class; - - my $self = {}; - - # with a sockets_path set then it makes no sense to set host and port - if ($args->{hosts}) { - $self->{hosts} = $args->{hosts}; - $self->{alive_hosts} = $self->{hosts}; - } - - if ($args->{username}) { - $self->{username} = $args->{username}; - } - if ($args->{ip}) { - $self->{ip} = $args->{ip}; - } - if ($args->{from}) { - $self->{from} = $args->{from}; - } - if ($args->{subject}) { - $self->{subject} = $args->{subject}; - } - if ($args->{rcpt}) { - $self->{rcpt} = $args->{rcpt}; - } - if ($args->{deliver_to}) { - $self->{deliver_to} = $args->{deliver_to}; - } - if ($args->{timeout}) { - $self->{timeout} = $args->{timeout}; - } - else { - $self->{timeout} = 5; - } - if ($args->{password}) { - $self->{password} = $args->{password}; - } - if ($args->{statfile}) { - $self->{statfile} = $args->{statfile}; - } - if ($args->{weight}) { - $self->{weight} = $args->{weight}; - } - else { - $self->{weight} = 1; - } - if ($args->{pass_all}) { - $self->{pass_all} = 1; - } - if ($args->{imap_search}) { - $self->{imap_search} = $args->{imap_search}; - } - else { - $self->{imap_search} = 'ALL'; - } - - if ($args->{command}) { - if ($args->{command} =~ /(SYMBOLS|PROCESS|CHECK|URLS|EMAILS)/i) { - $self->{'command'} = $1; - $self->{'control'} = 0; - } - elsif ($args->{command} =~ /(STAT|LEARN|SHUTDOWN|RELOAD|UPTIME|COUNTERS|FUZZY_ADD|FUZZY_DEL|WEIGHTS)/i) { - $self->{'command'} = $1; - $self->{'control'} = 1; - } - } - - $self->{error} = ""; - - bless($self, $class); - - $self; -} - - -sub make_ssl_socket { - my ($host, $port) = @_; - - eval { - require IO::Socket::SSL; - IO::Socket::SSL->import(LIST); - } or croak "IO::Socket::SSL required for imaps"; - - return IO::Socket::SSL->new("$host:$port"); -} - - - -=head2 process_item - -public instance (\%) process_item (String $item) - -Description: -Do specified command for a single file, path or IMAP folder - -The return value is a hash reference containing results of each command for each server from cluster - -=cut - -sub process_item { - my $self = shift; - my $item = shift; - my $cb = shift; - - if (defined ($item)) { - if ($item =~ qr|^imap(s?):user:([^:]+):password:([^:]*):host:([^:]+):mbox:(.+)$|) { - return $self->_process_imap ($1, $2, $3, $4, $5, $cb); - } - elsif (-f $item) { - return $self->_process_file ($item, $cb); - } - elsif (-d $item) { - return $self->_process_directory ($item, $cb); - } - else { - warn "urecognized argument: $item"; - } - } - undef; -} - -=head2 process_path - -public instance (\%) process_path () - -Description: -Do specified command for each file in path or message in IMAP folder - -The return value is a hash reference containing results of each command for each server from cluster - -=cut -sub process_path { - my $self = shift; - my $cb = shift; - my %res; - - foreach (@_) { - $res{$_} = $self->process_item($_, $cb); - } - - return \%res; -} - -=head2 do_all_cmd - -public instance (\%) do_all_cmd (String $msg) - -Description: -This method makes a call to the the whole rspamd cluster and call specified command -(in $self->{command}). - -The return value is a hash reference containing results of each command for each server from cluster - -=cut - -sub do_all_cmd { - my ($self, $input) = @_; - - my %res; - - if (!$self->{'hosts'} || scalar (@{ $self->{'hosts'} }) == 0) { - $res{'error'} = 'Hosts list is empty'; - $res{'error_code'} = 404; - } - else { - foreach my $hostdef (@{ $self->{'hosts'} }) { - $self->_clear_errors(); - - my $remote = $self->_create_connection($hostdef); - - if (! $remote) { - $res{$hostdef}->{error_code} = 404; - $res{$hostdef}->{error} = "Cannot connect to $hostdef"; - } - else { - if ($self->{'control'}) { - $res{$hostdef} = $self->_do_control_command ($remote, $input); - } - else { - $res{$hostdef} = $self->_do_rspamc_command ($remote, $input); - } - } - } - } - - return \%res; -} - -=head2 do_cmd - -public instance (\%) do_cmd (String $msg) - -Description: -This method makes a call to a single rspamd server from a cluster -(in $self->{command}). - -The return value is a hash reference containing results of each command for each server from cluster - -=cut - -sub do_cmd { - my ($self, $input) = @_; - - my $res; - - if (!$self->{'hosts'} || scalar (@{ $self->{'hosts'} }) == 0) { - $res->{'error'} = 'Hosts list is empty'; - $res->{'error_code'} = 404; - } - else { - $self->_clear_errors(); - - my $remote = $self->_create_connection(); - - if (! $remote) { - $res->{error_code} = 404; - $res->{error} = "Cannot connect to " . $remote; - } - else { - if ($self->{'control'}) { - $res = $self->_do_control_command ($remote, $input); - } - else { - $res = $self->_do_rspamc_command ($remote, $input); - } - } - } - - return $res; -} - - -=head2 check - -public instance (\%) check (String $msg) - -Description: -This method makes a call to the spamd server and depending on the value of -C<$is_check_p> either calls PROCESS or CHECK. - -The return value is a hash reference containing metrics indexed by name. Each metric -is hash that contains data: - -=over -=item * -isspam - -=item * -score - -=item * -threshold - -=item * -symbols - array of symbols - -=back - -=cut - -sub check { - my ($self, $msg) = @_; - - $self->{command} = 'CHECK'; - $self->{control} = 0; - - return $self->do_cmd ($msg); -} - -=head2 symbols - -public instance (\%) symbols (String $msg) - -Description: -This method makes a call to the spamd server - -The return value is a hash reference containing metrics indexed by name. Each metric -is hash that contains data: - -=over -=item * -isspam - -=item * -score - -=item * -threshold - -=item * -symbols - array of symbols - -=back - -=cut - -sub symbols { - my ($self, $msg) = @_; - - $self->{command} = 'SYMBOLS'; - $self->{control} = 0; - - return $self->do_cmd ($msg); -} - -=head2 process - -public instance (\%) process (String $msg) - -Description: -This method makes a call to the spamd server - -The return value is a hash reference containing metrics indexed by name. Each metric -is hash that contains data: - -=over -=item * -isspam - -=item * -score - -=item * -threshold - -=item * -symbols - array of symbols - -=back - -=cut -sub process { - my ($self, $msg) = @_; - - $self->{command} = 'PROCESS'; - $self->{control} = 0; - - return $self->do_cmd ($msg); -} - -=head2 urls - -public instance (\%) urls (String $msg) - -Description: -This method makes a call to the spamd server - -The return value is a hash reference containing metrics indexed by name. Each metric -is hash that contains data: - -urls - list of all urls in message -=cut -sub urls { - my ($self, $msg) = @_; - - $self->{command} = 'URLS'; - $self->{control} = 0; - - return $self->do_cmd ($msg); -} - - -=head2 learn - -public instance (\%) learn (String $msg) - -Description: -This method makes a call to the spamd learning a statfile with message. - -=cut - -sub learn { - my ($self, $msg) = @_; - - $self->{command} = 'learn'; - $self->{control} = 1; - - return $self->do_cmd ($msg); -} - -=head2 weights - -public instance (\%) weights (String $msg) - -Description: -This method makes a call to the spamd showing weights of message by each statfile. - -=cut -sub weights { - my ($self, $msg) = @_; - - $self->{command} = 'weights'; - $self->{control} = 1; - - return $self->do_cmd ($msg); -} - -=head2 fuzzy_add - -public instance (\%) fuzzy_add (String $msg) - -Description: -This method makes a call to the spamd adding specified message to fuzzy storage. - -=cut -sub fuzzy_add { - my ($self, $msg) = @_; - - $self->{command} = 'fuzzy_add'; - $self->{control} = 1; - - return $self->do_cmd ($msg); -} -=head2 fuzzy_del - -public instance (\%) fuzzy_add (String $msg) - -Description: -This method makes a call to the spamd removing specified message from fuzzy storage. - -=cut -sub fuzzy_del { - my ($self, $msg) = @_; - - $self->{command} = 'fuzzy_del'; - $self->{control} = 1; - - return $self->do_cmd ($msg); -} - -=head2 stat - -public instance (\%) stat () - -Description: -This method makes a call to the spamd and get statistics. - -=cut -sub stat { - my ($self) = @_; - - $self->{command} = 'stat'; - $self->{control} = 1; - - return $self->do_cmd (undef); -} -=head2 uptime - -public instance (\%) uptime () - -Description: -This method makes a call to the spamd and get uptime. - -=cut -sub uptime { - my ($self) = @_; - - $self->{command} = 'uptime'; - $self->{control} = 1; - - return $self->do_cmd (undef); -} -=head2 counters - -public instance (\%) counters () - -Description: -This method makes a call to the spamd and get counters. - -=cut -sub counters { - my ($self) = @_; - - $self->{command} = 'counters'; - $self->{control} = 1; - - return $self->do_cmd (undef); -} - -=head2 ping - -public instance (Boolean) ping () - -Description: -This method performs a server ping and returns 0 or 1 depending on -if the server responded correctly. - -=cut - -sub ping { - my $self = shift; - my $host = shift; - - my $remote; - $self->{control} = 0; - if (defined($host)) { - $remote = $self->_create_connection($host); - } - else { - # Create connection to random host from cluster - $remote = $self->_create_connection(); - } - - return undef unless $remote; - local $SIG{PIPE} = 'IGNORE'; - - if (!(syswrite($remote, "PING $PROTOVERSION$EOL"))) { - $self->_mark_dead($remote); - close($remote); - return 0; - } - syswrite($remote, $EOL); - - return undef unless $self->_get_io_readiness($remote, 0); - my $line; - sysread ($remote, $line, 255); - close $remote; - return undef unless $line; - - my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line); - return 0 unless (defined($resp_msg) && $resp_msg eq 'PONG'); - - return 1; -} - -=head1 PRIVATE METHODS - -=head2 _connect_host -private instance (IO::Socket) _create_host ($def) - -Description: -This method sets up a proper IO::Socket connection based on the arguments -used when greating the client object. - -On failure, it sets an internal error code and returns undef. -=cut - -sub _connect_host { - my ($self, $hostdef) = @_; - - my $remote; - - if ($hostdef =~ /^\//) { - if (! socket ($remote, PF_UNIX, SOCK_STREAM, 0)) { - carp "Cannot create unix socket\n"; - return undef; - } - my $sun = sockaddr_un($hostdef); - if (!connect ($remote, $sun)) { - carp "Cannot connect to socket $hostdef\n"; - close $remote; - return undef; - } - } - elsif ($hostdef =~ /^\s*(([^:]+):(\d+))\s*$/) { - my $peer_addr = $2; - if ($2 eq '*') { - $peer_addr = '127.0.0.1'; - } - $remote = IO::Socket::INET->new( Proto => "tcp", - PeerAddr => $peer_addr, - PeerPort => $3, - Blocking => 0, - ); - # Get write readiness - if (defined ($remote)) { - if ($self->_get_io_readiness($remote, 1) != 0) { - return $remote; - } - else { - close ($remote); - return undef; - } - } - } - elsif ($hostdef =~ /^\s*([^:]+)\s*$/) { - my $peer_addr = $1; - if ($1 eq '*') { - $peer_addr = '127.0.0.1'; - } - $remote = IO::Socket::INET->new( Proto => "tcp", - PeerAddr => $peer_addr, - PeerPort => $self->{control} ? 11334 : 11333, - Blocking => 0, - ); - # Get write readiness - if (defined ($remote)) { - if ($self->_get_io_readiness($remote, 1) != 0) { - return $remote; - } - else { - close ($remote); - return undef; - } - } - } - - unless ($remote) { - $self->{error} = "Failed to create connection to spamd daemon: $!\n"; - return undef; - } - $remote; - -} - -=head2 _create_connection -private instance (IO::Socket) _create_connection () - -Description: -This method sets up a proper IO::Socket connection based on the arguments -used when greating the client object. - -On failure, it sets an internal error code and returns undef. - -=cut - -sub _create_connection { - my ($self, $hostdef) = @_; - - my $tries = 0; - - if (!defined ($hostdef)) { - my $server; - - do { - $server = $self->_select_server(); - $tries ++; - - my $remote = $self->_connect_host ($server); - - return $remote if $remote; - } while ($tries < 5); - - return undef; - } - - return $self->_connect_host ($hostdef); -} - -=head2 _auth - -private instance (IO::Socket) _auth (Socket sock) - -Description: -This method do control auth. - -On failure this method returns 0 - -=cut -sub _auth { - my ($self, $sock) = @_; - - local $SIG{PIPE} = 'IGNORE'; - - if (!(syswrite($sock, "password $self->{password}$EOL"))) { - $self->_mark_dead($remote); - return 0; - } - - return 0 unless $self->_get_io_readiness($sock, 0); - - if (sysread($sock, $reply, 255)) { - if ($reply =~ /^password accepted/) { - return 0 unless $self->_get_io_readiness($sock, 0); - # read "END" - sysread($sock, $reply, 255); - return 1; - } - } - - return 0; - -} - -=head2 _revive_dead - -private instance (IO::Socket) _revive_dead () - -Description: -This method marks dead upstreams as alive - -=cut -sub _revive_dead { - my ($self) = @_; - - my $now = time(); - foreach my $s ($self->{dead_hosts}) { - # revive after minute of downtime - if (defined($s->{dead}) && $s->{dead} == 1 && $now - $s->{t} > 60) { - $s->{dead} = 0; - push(@{$self->{alive_hosts}}, $s->{host}); - } - } - - 1; -} - -=head2 _select_server - -private instance (IO::Socket) _select_server () - -Description: -This method returns one server from rspamd cluster or undef if there are no suitable ones - -=cut -sub _select_server { - my($self) = @_; - - return undef unless $self->{alive_hosts}; - - $self->_revive_dead(); - my $alive_num = scalar(@{$self->{alive_hosts}}); - if (!$alive_num) { - $self->{alive_hosts} = $self->{hosts}; - $self->{dead_hosts} = (); - $alive_num = scalar($self->{alive_hosts}); - } - - my $selected = $self->{alive_hosts}[int(rand($alive_num))]; - - $selected; -} - - -=head2 _select_server - -private instance (IO::Socket) _mark_dead (String server) - -Description: -This method marks upstream as dead for some time. It can be revived by _revive_dead method - -=cut -sub _mark_dead { - my ($self, $server) = @_; - - return undef unless $self->{hosts}; - my $now = time(); - $self->{dead_hosts}->{$server} = { - host => $server, - dead => 1, - t => $now, - }; - for (my $i = 0; $i < scalar (@{$self->{alive_hosts}}); $i ++) { - if ($self->{alive_hosts} == $server) { - splice(@{$self->{alive_hosts}}, $i, 1); - last; - } - } -} - -=head2 _get_io_readiness - -private instance (IO::Socket) _mark_dead (String server) - -Description: -This method marks upstream as dead for some time. It can be revived by _revive_dead method - -=cut -sub _get_io_readiness { - my ($self, $sock, $is_write) = @_; - my $w = ''; - vec($w, fileno($sock), 1) = 1; - - if ($is_write) { - return select(undef, $w, undef, $self->{timeout}); - } - else { - return select($w, undef,undef, $self->{timeout}); - } - - undef; -} - -=head2 _parse_response_line - -private instance (@) _parse_response_line (String $line) - -Description: -This method parses the initial response line/header from the server -and returns its parts. - -We have this as a seperate method in case we ever decide to get fancy -with the response line. - -=cut - -sub _parse_response_line { - my ($self, $line) = @_; - - $line =~ s/\r?\n$//; - return split(/\s+/, $line, 3); -} - -sub _write_message { - my $self = shift; - my $remote = shift; - my $message = shift; - my $len = shift; - - my $written = 0; - - while ($written < $len) { - last unless ($self->_get_io_readiness($remote, 1)); - my $cur = syswrite $remote, $message, $len, $written; - - last if ($cur <= 0); - $written += $cur; - } - - return $written == $len; -} - -=head2 _clear_errors - -private instance () _clear_errors () - -Description: -This method clears out any current errors. - -=cut - -sub _clear_errors { - my ($self) = @_; - - $self->{resp_code} = undef; - $self->{resp_msg} = undef; - $self->{error} = undef; -} - -# Currently just read stdin for user's message and pass it to rspamd -sub _do_rspamc_command { - my ($self, $remote, $msg) = @_; - - my %metrics; - my ($in, $res); - - my $msgsize = length($msg); - - local $SIG{PIPE} = 'IGNORE'; - - if (!(syswrite($remote, "$self->{command} $PROTOVERSION$EOL"))) { - $self->_mark_dead($remote); - my %r = ( - error => 'cannot connect to rspamd', - error_code => 502, - ); - close($remote); - return \%r; - } - syswrite $remote, "Content-length: $msgsize$EOL"; - syswrite $remote, "User: $self->{username}$EOL" if (exists($self->{username})); - syswrite $remote, "From: $self->{from}$EOL" if (exists($self->{from})); - syswrite $remote, "IP: $self->{ip}$EOL" if (exists($self->{ip})); - syswrite $remote, "Deliver-To: $self->{deliver_to}$EOL" if (exists($self->{deliver_to})); - syswrite $remote, "Subject: $self->{subject}$EOL" if (exists($self->{subject})); - syswrite $remote, "Pass: all$EOL" if (exists($self->{pass_all}) && $self->{pass_all}); - if (ref $self->{rcpt} eq "ARRAY") { - foreach ($self->{rcpt}) { - syswrite $remote, "Rcpt: $_ $EOL"; - } - } - syswrite $remote, $EOL; - - if (! $self->_write_message($remote, $msg, $msgsize)) { - my %r = ( - error => 'error writing message to rspamd', - error_code => 502, - ); - close $remote; - return \%r; - } - - #syswrite $remote, $EOL; - - unless ($self->_get_io_readiness($remote, 0)) { - close $remote; - my %r = ( - error => 'timed out while waiting for reply', - error_code => 502, - ); - return \%r; - } - - my $offset = 0; - do { - $res = sysread($remote, $in, 512, $offset); - if (!defined ($res)) { - close $remote; - my %r = ( - error => 'IO error while reading data from socket: ' . $!, - error_code => 503, - ); - return \%r; - } - if ($res > 0 && $res < 512) { - $self->_get_io_readiness($remote, 0); - } - $offset += $res; - } while ($res > 0); - - my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($in); - - $self->{resp_code} = $resp_code; - $self->{resp_msg} = $resp_msg; - - unless (defined($resp_code) && $resp_code == 0) { - close $remote; - my %r = ( - error => 'invalid reply', - error_code => 500, - ); - return \%r - } - - my $cur_metric; - my @lines = split (/^/, $in); - if (lc $self->{'command'} eq 'urls') { - $metrics{'default'} = { - isspam => 'false', - score => 0, - threshold => 0, - symbols => [], - urls => [], - messages => [], - action => 'reject', - }; - foreach my $line (@lines) { - if ($line =~ /^Urls: (.+)$/) { - @{ $metrics{'default'}->{'urls'} } = split /,\s+/, $1; - } - } - } - else { - foreach my $line (@lines) { - if ($line =~ m!Metric: (\S+); (\S+); (\S+) / (\S+) (/ (\S+))?!) { - $metrics{$1} = { - isspam => $2, - score => $3 + 0, - threshold => $4 + 0, - reject_score => $6, - symbols => [], - urls => [], - messages => [], - action => 'no action', - }; - $cur_metric = $1; - } - elsif ($line =~ /^Symbol: (\S+);\s*(.+?)\s*$/ && $cur_metric) { - # Line with parameters - my $symref = $metrics{$cur_metric}->{'symbols'}; - push(@$symref, "$1($2)"); - } - elsif ($line =~ /^Symbol: (\S+?)\s*$/ && $cur_metric) { - my $symref = $metrics{$cur_metric}->{'symbols'}; - push(@$symref, $1); - } - elsif ($line =~ /^Urls: (.+?)\s*$/ && $cur_metric) { - @{ $metrics{$cur_metric}->{'urls'} } = split /,\s+/, $1; - } - elsif ($line =~ /^Message: (.+?)\s*$/ && $cur_metric) { - my $symref = $metrics{$cur_metric}->{'messages'}; - push(@$symref, $1); - } - elsif ($line =~ /^Action: (.+?)\s*$/ && $cur_metric) { - $metrics{$cur_metric}->{'action'} = $1; - } - elsif ($line =~ /^${EOL}$/) { - last; - } - } - } - - close $remote; - - return \%metrics; - -} - - -sub _do_control_command { - my ($self, $remote, $msg) = @_; - - local $SIG{PIPE} = 'IGNORE'; - my %res = ( - error_code => 0, - error => '', - ); - - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - - # Read greeting first - if (defined (my $greeting = <$remote>)) { - if ($greeting !~ /^Rspamd version/) { - $res{error} = "Not rspamd greeting line $greeting"; - $res{error_code} = 500; - close($remote); - return \%res; - } - } - - if ($self->{'command'} =~ /^learn$/i) { - if (!$self->{'statfile'}) { - $res{error} = "Statfile is not specified to learn command"; - $res{error_code} = 500; - close($remote); - return \%res; - } - - if ($self->_auth ($remote)) { - my $len = length ($msg); - syswrite $remote, "learn $self->{statfile} $len -m $self->{weight}" . $EOL; - if (! $self->_write_message($remote, $msg, length($msg))) { - $res{error} = 'error writing message to rspamd'; - $res{error_code} = 502; - close $remote; - return \%res; - } - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - if (defined (my $reply = <$remote>)) { - if ($reply =~ /^learn ok, sum weight: ([0-9.]+)/) { - $res{error} = "Learn succeed. Sum weight: $1\n"; - close($remote); - return \%res; - } - else { - $res{error_code} = 500; - $res{error} = "Learn failed: $reply\n"; - close($remote); - return \%res; - } - } - } - else { - $res{error_code} = 403; - $res{error} = "Authentication failed\n"; - close($remote); - return \%res; - } - } - elsif ($self->{'command'} =~ /^weights$/i) { - if (!$self->{'statfile'}) { - $res{error_code} = 500; - $res{error} = "Statfile is not specified to weights command"; - close($remote); - return \%res; - } - - my $len = length ($msg); - $res{error} = "Sending $len bytes...\n"; - syswrite $remote, "weights $self->{'statfile'} $len" . $EOL; - if (! $self->_write_message($remote, $msg, length($msg))) { - $res{error} = 'error writing message to rspamd'; - $res{error_code} = 502; - close $remote; - return \%res; - } - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - while (defined (my $reply = <$remote>)) { - last if $reply =~ /^END/; - $res{error} .= $reply; - } - } - elsif ($self->{'command'} =~ /(reload|shutdown)/i) { - if ($self->_auth ($remote)) { - syswrite $remote, $self->{'command'} . $EOL; - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - while (defined (my $line = <$remote>)) { - last if $line =~ /^END/; - $res{error} .= $line; - } - } - else { - $res{error_code} = 403; - $res{error} = "Authentication failed\n"; - close($remote); - return \%res; - } - } - elsif ($self->{'command'} =~ /(fuzzy_add|fuzzy_del)/i) { - if ($self->_auth ($remote)) { - my $len = length ($msg); - syswrite $remote, $self->{'command'} . " $len $self->{'weight'}" . $EOL; - if (! $self->_write_message($remote, $msg, length($msg))) { - $res{error} = 'error writing message to rspamd'; - $res{error_code} = 502; - close $remote; - return \%res; - } - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - if (defined (my $reply = <$remote>)) { - if ($reply =~ /^OK/) { - $res{error} = $self->{'command'} . " succeed\n"; - close($remote); - return \%res; - } - else { - $res{error_code} = 500; - $res{error} = $self->{'command'} . " failed\n"; - close($remote); - return \%res; - } - } - } - else { - $res{error_code} = 403; - $res{error} = "Authentication failed\n"; - close($remote); - return \%res; - } - - } - else { - syswrite $remote, $self->{'command'} . $EOL; - unless ($self->_get_io_readiness($remote, 0)) { - $res{error} = "Timeout while reading data from socket"; - $res{error_code} = 501; - close($remote); - return \%res; - } - while (defined (my $line = <$remote>)) { - last if $line =~ /^END/; - $res{error} .= $line; - } - } - - close($remote); - return \%res; -} - -sub _process_file { - my $self = shift; - my $file = shift; - my $cb = shift; - my $res; - - open(FILE, "< $file") or return; - - my $input; - while (defined (my $line = )) { - $input .= $line; - } - - close FILE; - $res = $self->do_all_cmd ($input); - if (defined ($cb) && $res) { - $cb->($file, $res); - } -} - -sub _process_directory { - my $self = shift; - my $dir = shift; - my $cb = shift; - - opendir (DIR, $dir) or return; - - while (defined (my $file = readdir (DIR))) { - $file = "$dir/$file"; - if (-f $file) { - $self->_process_file ($file, $cb); - } - } - closedir (DIR); -} - -sub _check_imap_reply { - my $self = shift; - my $sock = shift; - my $seq = shift; - - my $input; - - while (defined ($input = <$sock>)) { - chomp $input; - if ($input =~ /BAD|NO (.+)$/) { - $_[0] = $1; - return 0; - } - next if ($input =~ /^\*/); - if ($input =~ /^$seq OK/) { - return 1; - } - - $_[0] = $input; - return 0; - } - - $_[0] = "timeout"; - - return 0; -} - -sub _parse_imap_body { - my $self = shift; - my $sock = shift; - my $seq = shift; - my $input; - my $got_body = 0; - - while (defined (my $line = <$sock>)) { - if (!$got_body && $line =~ /^\*/) { - $got_body = 1; - next; - } - if ($line =~ /^$seq OK/) { - return $input; - } - elsif ($got_body) { - $input .= $line; - next; - } - - return undef; - } - - return undef; - -} - -sub _parse_imap_sequences { - my $self = shift; - my $sock = shift; - my $seq = shift; - my $input; - - while (defined ($input = <$sock>)) { - chomp $input; - if ($input =~ /^\* SEARCH (.+)$/) { - @res = split (/\s/, $1); - next; - } - elsif ($input =~ /^$seq OK/) { - return \@res; - } - return undef; - } - -} - -sub _process_imap { - my ($self, $ssl, $user, $password, $host, $mbox, $cb) = @_; - my $seq = 1; - my $sock; - my $res; - - if (!$password) { - eval { - require Term::ReadKey; - Term::ReadKey->import( qw(ReadMode ReadLine) ); - print "Enter IMAP password: "; - ReadMode(2); - $password = ReadLine(0); - chomp $password; - ReadMode(0); - print "\n"; - } or croak "cannot get password. Check that Term::ReadKey is installed"; - } - - # Stupid code that does not take care of timeouts etc, just trying to extract messages - if ($ssl) { - $sock = $self->_make_ssl_socket ($host, 'imaps'); - } - else { - $sock = IO::Socket::INET->new( Proto => "tcp", - PeerAddr => $host, - PeerPort => 'imap', - Blocking => 1, - ); - } - unless ($sock) { - $self->{error} = "Cannot connect to imap server: $!"; - return; - } - my $reply = <$sock>; - if (!defined ($reply) || $reply !~ /^\* OK/) { - $self->{error} = "Imap server is not ready"; - return; - } - syswrite $sock, "$seq LOGIN $user $password$EOL"; - if (!$self->_check_imap_reply ($sock, $seq, $reply)) { - $self->{error} = "Cannot login to imap server: $reply"; - return; - } - $seq ++; - syswrite $sock, "$seq SELECT $mbox$EOL"; - if (!$self->_check_imap_reply ($sock, $seq, $reply)) { - $self->{error} = "Cannot select mbox $mbox: $reply"; - return; - } - $seq ++; - syswrite $sock, "$seq SEARCH $self->{imap_search}$EOL"; - my $messages; - if (!defined ($messages = $self->_parse_imap_sequences ($sock, $seq))) { - $self->{error} = "Cannot make search"; - return; - } - $seq ++; - foreach my $message (@{ $messages }){ - syswrite $sock, "$seq FETCH $message body[]$EOL"; - if (defined (my $input = $self->_parse_imap_body ($sock, $seq))) { - $self->do_all_cmd ($input); - if (defined ($cb) && $res) { - $cb->($seq, $res); - } - } - $seq ++; - } - syswrite $sock, "$seq LOGOUT$EOL"; - close $sock; -} - -1; diff --git a/perl/lib/Mail/Rspamd/Config.pm b/perl/lib/Mail/Rspamd/Config.pm deleted file mode 100644 index 7f3d8fefd..000000000 --- a/perl/lib/Mail/Rspamd/Config.pm +++ /dev/null @@ -1,593 +0,0 @@ -=head1 NAME - -Mail::Rspamd::Config - Utilities for rspamd configuration - -=head1 SYNOPSIS - -=head1 DESCRIPTION - -Mail::Rspamd::Config is a module that provides a perl implementation for -configuring rspamd. - -=cut - -package Mail::Rspamd::Config; - -use Carp; -use XML::Parser; - -use vars qw($VERSION); -$VERSION = "1.02"; - -use constant PARSER_STATE_START => 0; -use constant PARSER_STATE_MAIN => 1; -use constant PARSER_STATE_WORKER => 2; -use constant PARSER_STATE_MODULE => 3; -use constant PARSER_STATE_CLASSIFIER => 4; -use constant PARSER_STATE_STATFILE => 5; -use constant PARSER_STATE_LOGGING => 6; -use constant PARSER_STATE_METRIC => 8; -use constant PARSER_STATE_VIEW => 9; -use constant PARSER_STATE_MODULES => 10; -use constant PARSER_STATE_END => -1; - - -=head1 PUBLIC METHODS - -=head2 new - -public class (Mail::Rspamd::Config) new (\% $args) - -Description: -This method creates a new Mail::Rspamd::Config object. - -=cut - -sub new { - my ($class, $args) = @_; - - $class = ref($class) || $class; - - my $self = { - workers => [], - modules => {}, - classifiers => {}, - metrics => {}, - options => {}, - variables => {}, - logging => {}, - lua => [], - composites => {}, - paths => [], - views => [], - parser_state => { - state => PARSER_STATE_START, - valid => 1, - }, - }; - - if (defined ($args->{'file'})) { - $self->{'file'} = $args->{'file'} - } - - - bless($self, $class); - - $self; -} - -=head2 load - -public load (String $file) - -Description: -Loads rspamd config file and parses it. - -=cut - -sub load { - my ($self, $file) = @_; - - if (defined ($file)) { - $self->{'file'} = $file; - } - - if (!defined ($self->{'file'}) || ! -f $self->{'file'}) { - carp 'cannot open file specified'; - return undef; - } - - my $parser = new XML::Parser(Handlers => {Start => sub { $self->_handle_start_element(@_) }, - End => sub { $self->_handle_end_element(@_) }, - Char => sub { $self->_handle_text(@_) } }); - - $parser->parsefile($self->{file}); -} - -=head2 save - -public save (String $file) - -Description: -Dumps rspamd config to xml file. - -=cut - -sub save { - my ($self, $file) = @_; - - if (defined ($file)) { - $self->{'file'} = $file; - } - - if (!defined ($self->{'file'})) { - carp 'cannot open file specified'; - return undef; - } - - $self->_dump(); -} - -=head2 _handle_start_element - -private _handle_start_element($parser, $element, [attr, value...]) - -Description: -Handle start xml tag of rspamd - -=cut -sub _handle_start_element { - my ($self, $parser, $element, @attrs) = @_; - - - if ($self->{parser_state}->{valid}) { - # Start element - $self->{parser_state}->{element} = lc $element; - - if ($self->{parser_state}->{state} == PARSER_STATE_START) { - if (lc $element eq 'rspamd') { - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - } - else { - $self->{parser_state}->{valid} = 0; - $self->{error} = 'Start element missing, it must be , but is <' . $element . '>'; - } - } - # Main section - elsif ($self->{parser_state}->{state} == PARSER_STATE_MAIN) { - my $lce = lc $element; - if ($lce eq 'logging') { - $self->{parser_state}->{state} = PARSER_STATE_LOGGING; - } - elsif ($lce eq 'worker') { - $self->{parser_state}->{state} = PARSER_STATE_WORKER; - $self->{parser_state}->{worker} = { options => {} }; - } - elsif ($lce eq 'view') { - $self->{parser_state}->{state} = PARSER_STATE_VIEW; - $self->{parser_state}->{view} = {}; - } - elsif ($lce eq 'metric') { - $self->{parser_state}->{state} = PARSER_STATE_METRIC; - $self->{parser_state}->{metric} = { symbols => {} }; - } - elsif ($lce eq 'module') { - $self->{parser_state}->{state} = PARSER_STATE_MODULE; - $self->_get_attr('name', 'name', 1, @attrs); - $self->{parser_state}->{module} = {}; - } - elsif ($lce eq 'classifier') { - $self->{parser_state}->{state} = PARSER_STATE_CLASSIFIER; - $self->_get_attr('type', 'type', 1, @attrs); - $self->{parser_state}->{classifier} = { statfiles => []}; - } - elsif ($lce eq 'variable') { - $self->_get_attr('name', 'name', 1, @attrs); - } - elsif ($lce eq 'lua') { - $self->_get_attr('src', 'src', 1, @attrs); - } - elsif ($lce eq 'composite') { - $self->_get_attr('name', 'name', 1, @attrs); - } - elsif ($lce eq 'modules') { - $self->{parser_state}->{state} = PARSER_STATE_MODULES; - } - else { - # Other element - $self->{parser_state}->{element} = $lce; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_MODULE) { - my $lce = lc $element; - if ($lce eq 'option') { - $self->_get_attr('name', 'option', 1, @attrs); - } - else { - $self->{parser_state}->{valid} = 0; - $self->{error} = 'Invalid tag <' . $lce . '> in module section'; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_METRIC) { - my $lce = lc $element; - if ($lce eq 'symbol') { - $self->_get_attr('weight', 'weight', 1, @attrs); - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_CLASSIFIER) { - my $lce = lc $element; - if ($lce eq 'statfile') { - $self->{parser_state}->{state} = PARSER_STATE_STATFILE; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_WORKER) { - my $lce = lc $element; - if ($lce eq 'param') { - $self->_get_attr('name', 'name', 1, @attrs); - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_END) { - # Tags after end element - $self->{parser_state}->{valid} = 0; - $self->{error} = 'Invalid tag <' . $element . '> after end tag'; - } - else { - # On other states just set element - } - } -} - - -=head2 _handle_end_element - -private _handle_end_element($parser, $element) - -Description: -Handle end xml tag of rspamd - -=cut -sub _handle_end_element { - my ($self, $parser, $element) = @_; - - if ($self->{parser_state}->{valid}) { - my $lce = lc $element; - if ($self->{parser_state}->{state} == PARSER_STATE_MAIN) { - if ($lce eq 'rspamd') { - $self->{parser_state}->{state} = PARSER_STATE_END; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_WORKER) { - if ($lce eq 'worker') { - push(@{$self->{workers}}, $self->{parser_state}->{worker}); - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - $self->{parser_state}->{worker} = undef; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_CLASSIFIER) { - if ($lce eq 'classifier') { - $self->{classifiers}->{ $self->{parser_state}->{type} } = $self->{parser_state}->{classifier}; - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - $self->{parser_state}->{classifier} = undef; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_METRIC) { - if ($lce eq 'metric') { - if (exists ($self->{parser_state}->{metric}->{name})) { - $self->{metrics}->{ $self->{parser_state}->{metric}->{name} } = $self->{parser_state}->{metric}; - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - $self->{parser_state}->{metric} = undef; - } - else { - $self->{parser_state}->{valid} = 0; - $self->{error} = 'Metric must have tag'; - } - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_STATFILE) { - if ($lce eq 'statfile') { - push(@{$self->{parser_state}->{classifier}->{statfiles}}, $self->{parser_state}->{statfile}); - $self->{parser_state}->{state} = PARSER_STATE_CLASSIFIER; - $self->{parser_state}->{statfile} = undef; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_MODULE) { - if ($lce eq 'module') { - $self->{modules}->{ $self->{parser_state}->{name} } = $self->{parser_state}->{module}; - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - $self->{parser_state}->{module} = undef; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_LOGGING) { - if ($lce eq 'logging') { - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_VIEW) { - if ($lce eq 'view') { - push(@{$self->{views}}, $self->{parser_state}->{view}); - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - $self->{parser_state}->{view} = undef; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_MODULES) { - if ($lce eq 'modules') { - $self->{parser_state}->{state} = PARSER_STATE_MAIN; - } - } - } -} - -=head2 _handle_text - -private _handle_text($parser, $string) - -Description: -Handle data of xml tag - -=cut -sub _handle_text { - my ($self, $parser, $string) = @_; - - my $data; - - if (defined ($string) && $string =~ /^\s*(\S*(?:\s+\S+)*)\s*$/) { - $data = $1; - } - else { - return undef; - } - if (!$data) { - return undef; - } - - if ($self->{parser_state}->{valid}) { - if ($self->{parser_state}->{state} == PARSER_STATE_MAIN) { - if ($self->{parser_state}->{element} eq 'variable') { - $self->{variables}->{ $self->{parser_state}->{name} } = $data; - } - elsif ($self->{parser_state}->{element} eq 'composite') { - $self->{composites}->{ $self->{parser_state}->{name} } = $data; - } - elsif ($self->{parser_state}->{element} eq 'lua') { - push(@{$self->{lua}}, $self->{parser_state}->{src}); - } - else { - $self->{options}->{ $self->{parser_state}->{element} } = $data; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_LOGGING) { - $self->{logging}->{ $self->{parser_state}->{element} } = $data; - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_WORKER) { - if ($self->{parser_state}->{element} eq 'param' || $self->{parser_state}->{element} eq 'option') { - $self->{parser_state}->{worker}->{options}->{$self->{parser_state}->{name}} = $data; - } - else { - $self->{parser_state}->{worker}->{ $self->{parser_state}->{element} } = $data; - } - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_CLASSIFIER) { - $self->{parser_state}->{classifier}->{ $self->{parser_state}->{element} } = $data; - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_STATFILE) { - $self->{parser_state}->{statfile}->{ $self->{parser_state}->{element} } = $data; - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_MODULE) { - $self->{parser_state}->{module}->{ $self->{parser_state}->{option} } = $data; - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_VIEW) { - $self->{parser_state}->{view}->{ $self->{parser_state}->{option} } = $data; - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_MODULES) { - push(@{$self->{paths}}, $data); - } - elsif ($self->{parser_state}->{state} == PARSER_STATE_METRIC) { - if ($self->{parser_state}->{element} eq 'symbol') { - $self->{parser_state}->{metric}->{symbols}->{ $data } = $self->{parser_state}->{weight}; - } - else { - $self->{parser_state}->{metric}->{ $self->{parser_state}->{element} } = $data; - } - } - } -} - -=head2 _get_attr - -private _get_attr($name, $hash_name, $required, @attrs) - -Description: -Extract specified attr and put it to parser_state - -=cut -sub _get_attr { - my ($self, $name, $hash_name, $required, @attrs) = @_; - my $found = 0; - my $param = 1; - - foreach (@attrs) { - if ($found) { - $self->{parser_state}->{$hash_name} = $_; - last; - } - else { - if ($param) { - if (lc $_ eq $name) { - $found = 1; - } - $param = 0; - } - else { - $param = 1; - } - } - } - - if (!$found && $required) { - $self->{error} = "Attribute '$name' is required for tag '$self->{parser_state}->{element}'"; - $self->{parser_state}->{'valid'} = 0; - } -} - -=head2 _dump - -private _dump() - -Description: -Dumps rspamd config to xml file - -=cut -sub _dump { - my ($self) = @_; - - open(XML, "> $self->{file}") or carp "cannot open file '$self->file'"; - - print XML "\n\n"; - - print XML "\n"; - while(my ($k, $v) = each (%{$self->{options}})) { - my $ek = $self->_xml_escape($k); - print XML "<$ek>" . $self->_xml_escape($v) . "\n"; - } - foreach my $lua(@{$self->{lua}}) { - print XML "_xml_escape($lua) ."\">lua\n"; - } - print XML "\n\n"; - - print XML "\n"; - while(my ($k, $v) = each (%{$self->{variables}})) { - my $ek = $self->_xml_escape($k); - print XML "" . $self->_xml_escape($v) . "\n"; - } - print XML "\n\n"; - - print XML "\n"; - while(my ($k, $v) = each (%{$self->{composites}})) { - my $ek = $self->_xml_escape($k); - print XML "" . $self->_xml_escape($v) . "\n"; - } - print XML "\n\n"; - - print XML "\n"; - foreach my $worker (@{$self->{workers}}) { - print XML "\n"; - while (my ($k, $v) = each (%{$worker})) { - my $ek = $self->_xml_escape($k); - if ($k eq 'options') { - while (my ($kk, $vv) = each (%{$v})) { - print XML " _xml_escape($kk) ."\">" . $self->_xml_escape($vv) . "\n"; - } - } - else { - print XML " <$ek>" . $self->_xml_escape($v) . "\n"; - } - } - print XML "\n"; - } - print XML "\n\n"; - - print XML "\n"; - while (my ($k, $v) = each (%{$self->{metrics}})) { - print XML "_xml_escape($k) ."\">\n"; - while (my ($kk, $vv) = each (%{ $v })) { - my $ek = $self->_xml_escape($kk); - if ($ek eq 'symbols') { - while (my ($sym, $weight) = each (%{ $vv })) { - print XML " _xml_escape($weight) ."\">" . $self->_xml_escape($sym) . "\n"; - } - } - else { - print XML " <$ek>" . $self->_xml_escape($vv) . "\n"; - } - } - print XML "\n"; - } - print XML "\n\n"; - - print XML "\n\n"; - while (my ($k, $v) = each (%{$self->{logging}})) { - my $ek = $self->_xml_escape($k); - print XML " <$ek>" . $self->_xml_escape($v) . "\n"; - } - print XML "\n\n\n"; - - print XML "\n"; - while (my ($type, $classifier) = each(%{$self->{classifiers}})) { - print XML "_xml_escape($type) ."\">\n"; - while (my ($k, $v) = each (%{$classifier})) { - my $ek = $self->_xml_escape($k); - if ($k eq 'statfiles') { - foreach my $statfile (@{$v}) { - print XML " \n"; - while (my ($kk, $vv) = each (%{$statfile})) { - my $ekk = $self->_xml_escape($kk); - print XML " <$ekk>" . $self->_xml_escape($vv) . "\n"; - } - print XML " \n"; - } - } - else { - print XML " <$ek>" . $self->_xml_escape($v) . "\n"; - } - } - print XML "\n"; - } - print XML "\n\n"; - - print XML "\n"; - while (my ($name, $module) = each(%{$self->{modules}})) { - print XML "_xml_escape($name) ."\">\n"; - while (my ($k, $v) = each (%{$module})) { - my $ek = $self->_xml_escape($k); - print XML " \n"; - } - print XML "\n"; - } - print XML "\n\n"; - - print XML "\n\n"; - foreach my $module(@{$self->{paths}}) { - print XML " " . $self->_xml_escape($module) . "\n"; - } - print XML "\n\n\n"; - - print XML "\n"; -} - -=head2 _xml_escape - -private _xml_escape() - -Description: -Escapes characters in xml string - -=cut -sub _xml_escape { - my $data = $_[1]; - if ($data =~ /[\&\<\>\"]/) { - $data =~ s/\&/\&\;/g; - $data =~ s/\/\>\;/g; - $data =~ s/\"/\"\;/g; - } - return $data; -} - -=head2 _xml_unescape - -private _xml_unescape() - -Description: -Unescapes characters in xml string - -=cut -sub _xml_unescape { - my $data = $_[1]; - if ($data =~ /\&|\<|\>|\"/) { - $data =~ s/\&/\&/g; - $data =~ s/\<\;/\/g; - $data =~ s/\"\;/\"/g; - } - return $data; -} -- 2.39.5