]> git.proxmox.com Git - pmg-api.git/blobdiff - PMG/Utils.pm
add custom_check handling
[pmg-api.git] / PMG / Utils.pm
index bcd193ab20763e9a18571e20972afc945165e6e8..473a88fc7fae67dc22979c4e50dda66c9a239a6a 100644 (file)
@@ -13,13 +13,20 @@ use File::Basename;
 use MIME::Words;
 use MIME::Parser;
 use Time::HiRes qw (gettimeofday);
+use Time::Local;
 use Xdgmime;
 use Data::Dumper;
 use Digest::SHA;
+use Digest::MD5;
 use Net::IP;
 use Socket;
 use RRDs;
 use Filesys::Df;
+use Encode;
+use utf8;
+no utf8;
+
+use HTML::Entities;
 
 use PVE::ProcFSTools;
 use PVE::Network;
@@ -30,25 +37,29 @@ use PMG::AtomicFile;
 use PMG::MailQueue;
 use PMG::SMTPPrinter;
 
-my $realm_regex = qr/[A-Za-z][A-Za-z0-9\.\-_]+/;
-
-PVE::JSONSchema::register_format('pmg-realm', \&verify_realm);
-sub verify_realm {
-    my ($realm, $noerr) = @_;
-
-    if ($realm !~ m/^${realm_regex}$/) {
-       return undef if $noerr;
-       die "value does not look like a valid realm\n";
-    }
-    return $realm;
-}
+my $valid_pmg_realms = ['pam', 'pmg', 'quarantine'];
 
 PVE::JSONSchema::register_standard_option('realm', {
     description => "Authentication domain ID",
-    type => 'string', format => 'pmg-realm',
+    type => 'string',
+    enum => $valid_pmg_realms,
     maxLength => 32,
 });
 
+PVE::JSONSchema::register_standard_option('pmg-starttime', {
+    description => "Only consider entries newer than 'starttime' (unix epoch). Default is 'now - 1day'.",
+    type => 'integer',
+    minimum => 0,
+    optional => 1,
+});
+
+PVE::JSONSchema::register_standard_option('pmg-endtime', {
+    description => "Only consider entries older than 'endtime' (unix epoch). This is set to '<start> + 1day' by default.",
+    type => 'integer',
+    minimum => 1,
+    optional => 1,
+});
+
 PVE::JSONSchema::register_format('pmg-userid', \&verify_username);
 sub verify_username {
     my ($username, $noerr) = @_;
@@ -69,7 +80,8 @@ sub verify_username {
     # colon separated lists)!
     # slash is not allowed because it is used as pve API delimiter
     # also see "man useradd"
-    if ($username =~ m!^([^\s:/]+)\@(${realm_regex})$!) {
+    my $realm_list = join('|', @$valid_pmg_realms);
+    if ($username =~ m!^([^\s:/]+)\@(${realm_list})$!) {
        return wantarray ? ($username, $1, $2) : $username;
     }
 
@@ -93,11 +105,20 @@ PVE::JSONSchema::register_standard_option('username', {
     maxLength => 64,
 });
 
-sub msgquote {
-    my $msg = shift || '';
-    $msg =~ s/%/%%/g;
-    return $msg;
-}
+PVE::JSONSchema::register_standard_option('pmg-email-address', {
+    description => "Email Address (allow most characters).",
+    type => 'string',
+    pattern => '(?:[^\s\/\\\@]+\@[^\s\/\\\@]+)',
+    maxLength => 512,
+    minLength => 3,
+});
+
+PVE::JSONSchema::register_standard_option('pmg-whiteblacklist-entry-list', {
+    description => "White/Blacklist entry list (allow most characters). Can contain globs",
+    type => 'string',
+    pattern => '(?:[^\s\/\\\;\,]+)(?:\,[^\s\/\\\;\,]+)*',
+    minLength => 3,
+});
 
 sub lastid {
     my ($dbh, $seq) = @_;
@@ -106,11 +127,13 @@ sub lastid {
        undef, undef, undef, undef, { sequence => $seq});
 }
 
-sub encrypt_pw {
-    my ($pw) = @_;
+# quote all regex operators
+sub quote_regex {
+    my $val = shift;
 
-    my $time = substr(Digest::SHA::sha1_base64(time), 0, 8);
-    return crypt(encode("utf8", $pw), "\$5\$$time\$");
+    $val =~ s/([\(\)\[\]\/\}\+\*\?\.\|\^\$\\])/\\$1/g;
+
+    return $val;
 }
 
 sub file_older_than {
@@ -195,16 +218,42 @@ sub reinject_mail {
            }
        }
 
-       if (!$smtp->mail($sender)) {
+       my $has_utf8_targets = 0;
+       foreach my $target (@$targets) {
+           if (utf8::is_utf8($target)) {
+               $has_utf8_targets = 1;
+               last;
+           }
+       }
+
+       my $mail_opts = " BODY=8BITMIME";
+       my $sender_addr;
+       if (utf8::is_utf8($sender)) {
+           $sender_addr = encode('UTF-8', $smtp->_addr($sender));
+           $mail_opts .= " SMTPUTF8";
+       } else {
+           $sender_addr = $smtp->_addr($sender);
+           $mail_opts .= " SMTPUTF8" if $has_utf8_targets;
+       }
+
+       if (!$smtp->_MAIL("FROM:" . $sender_addr . $mail_opts)) {
            syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
            die "smtp from: ERROR";
        }
 
-       my $dsnopts = $nodsn ? {Notify => ['NEVER']} : {};
+       my $rcpt_opts = $nodsn ? " NOTIFY=NEVER" : "";
 
-       if (!$smtp->to (@$targets, $dsnopts)) {
-           syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
-           die "smtp to: ERROR";
+       foreach my $target (@$targets) {
+           my $rcpt_addr;
+           if (utf8::is_utf8($target)) {
+               $rcpt_addr = encode('UTF-8', $smtp->_addr($target));
+           } else {
+               $rcpt_addr = $smtp->_addr($target);
+           }
+           if (!$smtp->_RCPT("TO:" . $rcpt_addr . $rcpt_opts)) {
+               syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
+               die "smtp to: ERROR";
+           }
        }
 
        # Output the head:
@@ -244,6 +293,83 @@ sub reinject_mail {
     return wantarray ? ($resid, $rescode, $resmess) : $resid;
 }
 
+sub analyze_custom_check {
+    my ($queue, $dname, $pmg_cfg) = @_;
+
+    my $enable_custom_check = $pmg_cfg->get('admin', 'custom_check');
+    return undef if !$enable_custom_check;
+
+    my $timeout = 60*5;
+    my $customcheck_exe = $pmg_cfg->get('admin', 'custom_check_path');
+    my $customcheck_apiver = 'v1';
+    my ($csec, $usec) = gettimeofday();
+
+    my $vinfo;
+    my $spam_score;
+
+    eval {
+
+       my $log_err = sub {
+           my ($errmsg) = @_;
+           $errmsg =~ s/%/%%/;
+           syslog('err', $errmsg);
+       };
+
+       my $customcheck_output_apiver;
+       my $have_result;
+       my $parser = sub {
+           my ($line) = @_;
+
+           my $result_flag;
+           if ($line =~ /^v\d$/) {
+               die "api version already defined!\n" if defined($customcheck_output_apiver);
+               $customcheck_output_apiver = $line;
+               die "api version mismatch - expected $customcheck_apiver, got $customcheck_output_apiver !\n"
+                   if ($customcheck_output_apiver ne $customcheck_apiver);
+           } elsif ($line =~ /^SCORE: (-?[0-9]+|.[0-9]+|[0-9]+.[0-9]+)$/) {
+               $spam_score = $1;
+               $result_flag = 1;
+           } elsif ($line =~ /^VIRUS: (.+)$/) {
+               $vinfo = $1;
+               $result_flag = 1;
+           } elsif ($line =~ /^OK$/) {
+               $result_flag = 1;
+           } else {
+               die "got unexpected output!\n";
+           }
+           die "got more than 1 result outputs\n" if ( $have_result && $result_flag);
+           $have_result = $result_flag;
+       };
+
+       PVE::Tools::run_command([$customcheck_exe, $customcheck_apiver, $dname],
+           errmsg => "$queue->{logid} custom check error",
+           errfunc => $log_err, outfunc => $parser, timeout => $timeout);
+
+       die "no api version returned\n" if !defined($customcheck_output_apiver);
+       die "no result output!\n" if !$have_result;
+    };
+    my $err = $@;
+
+    if ($vinfo) {
+       syslog('info', "$queue->{logid}: virus detected: $vinfo (custom)");
+    }
+
+    my ($csec_end, $usec_end) = gettimeofday();
+    $queue->{ptime_custom} =
+       int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
+
+    if ($err) {
+       syslog ('err', $err);
+       $vinfo = undef;
+       $queue->{errors} = 1;
+    }
+
+    $queue->{vinfo_custom} = $vinfo;
+    $queue->{spam_custom} = $spam_score;
+
+    return ($vinfo, $spam_score);
+}
+
 sub analyze_virus_clam {
     my ($queue, $dname, $pmg_cfg) = @_;
 
@@ -314,13 +440,96 @@ sub analyze_virus_clam {
     return $vinfo ? "$vinfo (clamav)" : undef;
 }
 
+sub analyze_virus_avast {
+    my ($queue, $dname, $pmg_cfg) = @_;
+
+    my $timeout = 60*5;
+    my $vinfo;
+
+    my ($csec, $usec) = gettimeofday();
+
+    my $previous_alarm;
+
+    eval {
+
+       $previous_alarm = alarm($timeout);
+
+       $SIG{ALRM} = sub {
+           die "$queue->{logid}: Maximum time ($timeout sec) exceeded. " .
+               "virus analyze (avast) failed: ERROR";
+       };
+
+       open(my $cmd, '-|', '/bin/scan', $dname) ||
+           die "$queue->{logid}: can't exec avast scan: $! : ERROR";
+
+       my $response = '';
+       while (defined(my $line = <$cmd>)) {
+           if ($line =~ m/^$dname\s+(.*\S)\s*$/) {
+               # we just use the first detected virus name
+               $vinfo = $1 if !$vinfo;
+           }
+
+           $response .= $line;
+       }
+
+       close($cmd);
+
+       alarm(0); # avoid race conditions
+
+       if ($vinfo) {
+           syslog('info', "$queue->{logid}: virus detected: $vinfo (avast)");
+       }
+    };
+    my $err = $@;
+
+    alarm($previous_alarm);
+
+    my ($csec_end, $usec_end) = gettimeofday();
+    $queue->{ptime_clam} =
+       int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
+
+    if ($err) {
+       syslog ('err', $err);
+       $vinfo = undef;
+       $queue->{errors} = 1;
+    }
+
+    return undef if !$vinfo;
+
+    $queue->{vinfo_avast} = $vinfo;
+
+    return "$vinfo (avast)";
+}
+
 sub analyze_virus {
     my ($queue, $filename, $pmg_cfg, $testmode) = @_;
 
     # TODO: support other virus scanners?
 
-    # always scan with clamav
-    return analyze_virus_clam($queue, $filename, $pmg_cfg);
+    if ($testmode) {
+       my $vinfo_clam = analyze_virus_clam($queue, $filename, $pmg_cfg);
+       my $vinfo_avast = analyze_virus_avast($queue, $filename, $pmg_cfg);
+
+       return $vinfo_avast || $vinfo_clam;
+    }
+
+    my $enable_avast  = $pmg_cfg->get('admin', 'avast');
+
+    if ($enable_avast) {
+       if (my $vinfo = analyze_virus_avast($queue, $filename, $pmg_cfg)) {
+           return $vinfo;
+       }
+    }
+
+    my $enable_clamav = $pmg_cfg->get('admin', 'clamav');
+
+    if ($enable_clamav) {
+       if (my $vinfo = analyze_virus_clam($queue, $filename, $pmg_cfg)) {
+           return $vinfo;
+       }
+    }
+
+    return undef;
 }
 
 sub magic_mime_type_for_file {
@@ -458,7 +667,7 @@ __EOD__
 }
 
 sub find_local_network_for_ip {
-    my ($ip) = @_;
+    my ($ip, $noerr) = @_;
 
     my $testip = Net::IP->new($ip);
 
@@ -486,24 +695,90 @@ sub find_local_network_for_ip {
        }
     }
 
+    return undef if $noerr;
+
     die "unable to detect local network for ip '$ip'\n";
 }
 
+my $service_aliases = {
+    'postfix' =>  'postfix@-',
+    'postgres' => 'postgresql@9.6-main',
+};
+
+sub lookup_real_service_name {
+    my $alias = shift;
+
+    return $service_aliases->{$alias} // $alias;
+}
+
+sub get_full_service_state {
+    my ($service) = @_;
+
+    my $res;
+
+    my $parser = sub {
+       my $line = shift;
+       if ($line =~ m/^([^=\s]+)=(.*)$/) {
+           $res->{$1} = $2;
+       }
+    };
+
+    $service = $service_aliases->{$service} // $service;
+    PVE::Tools::run_command(['systemctl', 'show', $service], outfunc => $parser);
+
+    return $res;
+}
+
+our $db_service_list = [
+    'pmgpolicy', 'pmgmirror', 'pmgtunnel', 'pmg-smtp-filter' ];
+
+sub service_wait_stopped {
+    my ($timeout, $service_list) = @_;
+
+    my $starttime = time();
+
+    foreach my $service (@$service_list) {
+       PVE::Tools::run_command(['systemctl', 'stop', $service]);
+    }
+
+    while (1) {
+       my $wait = 0;
+
+       foreach my $service (@$service_list) {
+           my $ss = get_full_service_state($service);
+           my $state = $ss->{ActiveState} // 'unknown';
+
+           if ($state ne 'inactive') {
+               if ((time() - $starttime) > $timeout) {
+                   syslog('err', "unable to stop services (got timeout)");
+                   $wait = 0;
+                   last;
+               }
+               $wait = 1;
+           }
+       }
+
+       last if !$wait;
+
+       sleep(1);
+    }
+}
+
 sub service_cmd {
     my ($service, $cmd) = @_;
 
     die "unknown service command '$cmd'\n"
-       if $cmd !~ m/^(start|stop|restart|reload)$/;
+       if $cmd !~ m/^(start|stop|restart|reload|reload-or-restart)$/;
 
     if ($service eq 'pmgdaemon' || $service eq 'pmgproxy') {
-       if ($cmd eq 'restart') {
-           # OK
-       } else {
-           die "invalid service cmd '$service $cmd': ERROR";
-       }
+       die "invalid service cmd '$service $cmd': ERROR" if $cmd eq 'stop';
+    } elsif ($service eq 'fetchmail') {
+       # use restart instead of start - else it does not start 'exited' unit
+       # after setting START_DAEMON=yes in /etc/default/fetchmail
+       $cmd = 'restart' if $cmd eq 'start';
     }
 
-    $service = 'postfix@-' if $service eq 'postfix';
+    $service = $service_aliases->{$service} // $service;
     PVE::Tools::run_command(['systemctl', $cmd, $service]);
 };
 
@@ -539,6 +814,14 @@ sub run_postmap {
     # make sure the file exists (else postmap fails)
     IO::File->new($filename, 'a', 0644);
 
+    my $mtime_src = (CORE::stat($filename))[9] //
+       die "unbale to read mtime of $filename\n";
+
+    my $mtime_dst = (CORE::stat("$filename.db"))[9] // 0;
+
+    # if not changed, do nothing
+    return if $mtime_src <= $mtime_dst;
+
     eval {
        PVE::Tools::run_command(
            ['/usr/sbin/postmap', $filename],
@@ -707,7 +990,7 @@ sub update_node_status_rrd {
     my $netin = 0;
     my $netout = 0;
     foreach my $dev (keys %$netdev) {
-       next if $dev !~ m/^eth\d+$/;
+       next if $dev !~ m/^$PVE::Network::PHYSICAL_NIC_RE$/;
        $netin += $netdev->{$dev}->{receive};
        $netout += $netdev->{$dev}->{transmit};
     }
@@ -797,4 +1080,302 @@ sub create_rrd_data {
     return $res;
 }
 
+sub decode_to_html {
+    my ($charset, $data) = @_;
+
+    my $res = $data;
+
+    eval { $res = encode_entities(decode($charset, $data)); };
+
+    return $res;
+}
+
+sub decode_rfc1522 {
+    my ($enc) = @_;
+
+    my $res = '';
+
+    return '' if !$enc;
+
+    eval {
+       foreach my $r (MIME::Words::decode_mimewords($enc)) {
+           my ($d, $cs) = @$r;
+           if ($d) {
+               if ($cs) {
+                   $res .= decode($cs, $d);
+               } else {
+                   $res .= $d;
+               }
+           }
+       }
+    };
+
+    $res = $enc if $@;
+
+    return $res;
+}
+
+sub rfc1522_to_html {
+    my ($enc) = @_;
+
+    my $res = '';
+
+    return '' if !$enc;
+
+    eval {
+       foreach my $r (MIME::Words::decode_mimewords($enc)) {
+           my ($d, $cs) = @$r;
+           if ($d) {
+               if ($cs) {
+                   $res .= encode_entities(decode($cs, $d));
+               } else {
+                   $res .= encode_entities($d);
+               }
+           }
+       }
+    };
+
+    $res = $enc if $@;
+
+    return $res;
+}
+
+# RFC 2047 B-ENCODING http://rfc.net/rfc2047.html
+# (Q-Encoding is complex and error prone)
+sub bencode_header {
+    my $txt = shift;
+
+    my $CRLF = "\015\012";
+
+    # Nonprintables (controls + x7F + 8bit):
+    my $NONPRINT = "\\x00-\\x1F\\x7F-\\xFF";
+
+    # always use utf-8 (work with japanese character sets)
+    $txt = encode("UTF-8", $txt);
+
+    return $txt if $txt !~ /[$NONPRINT]/o;
+
+    my $res = '';
+
+    while ($txt =~ s/^(.{1,42})//sm) {
+       my $t = MIME::Words::encode_mimeword ($1, 'B', 'UTF-8');
+       $res .= $res ? "\015\012\t$t" : $t;
+    }
+
+    return $res;
+}
+
+sub load_sa_descriptions {
+    my ($additional_dirs) = @_;
+
+    my @dirs = ('/usr/share/spamassassin',
+               '/usr/share/spamassassin-extra');
+
+    push @dirs, @$additional_dirs if @$additional_dirs;
+
+    my $res = {};
+
+    my $parse_sa_file = sub {
+       my ($file) = @_;
+
+       open(my $fh,'<', $file);
+       return if !defined($fh);
+
+       while (defined(my $line = <$fh>)) {
+           if ($line =~ m/^describe\s+(\S+)\s+(.*)\s*$/) {
+               my ($name, $desc) = ($1, $2);
+               next if $res->{$name};
+               $res->{$name}->{desc} = $desc;
+               if ($desc =~ m|[\(\s](http:\/\/\S+\.[^\s\.\)]+\.[^\s\.\)]+)|i) {
+                   $res->{$name}->{url} = $1;
+               }
+           }
+       }
+       close($fh);
+    };
+
+    foreach my $dir (@dirs) {
+       foreach my $file (<$dir/*.cf>) {
+           $parse_sa_file->($file);
+       }
+    }
+
+    $res->{'ClamAVHeuristics'}->{desc} = "ClamAV heuristic tests";
+
+    return $res;
+}
+
+sub format_uptime {
+    my ($uptime) = @_;
+
+    my $days = int($uptime/86400);
+    $uptime -= $days*86400;
+
+    my $hours = int($uptime/3600);
+    $uptime -= $hours*3600;
+
+    my $mins = $uptime/60;
+
+    if ($days) {
+       my $ds = $days > 1 ? 'days' : 'day';
+       return sprintf "%d $ds %02d:%02d", $days, $hours, $mins;
+    } else {
+       return sprintf "%02d:%02d", $hours, $mins;
+    }
+}
+
+sub finalize_report {
+    my ($tt, $template, $data, $mailfrom, $receiver, $debug) = @_;
+
+    my $html = '';
+
+    $tt->process($template, $data, \$html) ||
+       die $tt->error() . "\n";
+
+    my $title;
+    if ($html =~ m|^\s*<title>(.*)</title>|m) {
+       $title = $1;
+    } else {
+       die "unable to extract template title\n";
+    }
+
+    my $top = MIME::Entity->build(
+       Type    => "multipart/related",
+       To      => $data->{pmail},
+       From    => $mailfrom,
+       Subject => bencode_header(decode_entities($title)));
+
+    $top->attach(
+       Data     => $html,
+       Type     => "text/html",
+       Encoding => $debug ? 'binary' : 'quoted-printable');
+
+    if ($debug) {
+       $top->print();
+       return;
+    }
+    # we use an empty envelope sender (we dont want to receive NDRs)
+    PMG::Utils::reinject_mail ($top, '', [$receiver], undef, $data->{fqdn});
+}
+
+sub lookup_timespan {
+    my ($timespan) = @_;
+
+    my (undef, undef, undef, $mday, $mon, $year) = localtime(time());
+    my $daystart = timelocal(0, 0, 0, $mday, $mon, $year);
+
+    my $start;
+    my $end;
+
+    if ($timespan eq 'today') {
+       $start = $daystart;
+       $end = $start + 86400;
+    } elsif ($timespan eq 'yesterday') {
+       $end = $daystart;
+       $start = $end - 86400;
+    } elsif ($timespan eq 'week') {
+       $end = $daystart;
+       $start = $end - 7*86400;
+    } else {
+       die "internal error";
+    }
+
+    return ($start, $end);
+}
+
+my $rbl_scan_last_cursor;
+my $rbl_scan_start_time = time();
+
+sub scan_journal_for_rbl_rejects {
+
+    # example postscreen log entry for RBL rejects
+    # Aug 29 08:00:36 proxmox postfix/postscreen[11266]: NOQUEUE: reject: RCPT from [x.x.x.x]:1234: 550 5.7.1 Service unavailable; client [x.x.x.x] blocked using zen.spamhaus.org; from=<xxxx>, to=<yyyy>, proto=ESMTP, helo=<zzz>
+
+    # example for PREGREET reject
+    # Dec  7 06:57:11 proxmox postfix/postscreen[32084]: PREGREET 14 after 0.23 from [x.x.x.x]:63492: EHLO yyyyy\r\n
+
+    my $identifier = 'postfix/postscreen';
+
+    my $rbl_count = 0;
+    my $pregreet_count = 0;
+
+    my $parser = sub {
+       my $line = shift;
+
+       if ($line =~ m/^--\scursor:\s(\S+)$/) {
+           $rbl_scan_last_cursor = $1;
+           return;
+       }
+
+       if ($line =~ m/\s$identifier\[\d+\]:\sNOQUEUE:\sreject:.*550 5.7.1 Service unavailable;/) {
+           $rbl_count++;
+       } elsif ($line =~ m/\s$identifier\[\d+\]:\sPREGREET\s\d+\safter\s/) {
+           $pregreet_count++;
+       }
+    };
+
+    # limit to last 5000 lines to avoid long delays
+    my $cmd = ['journalctl', '--show-cursor', '-o', 'short-unix', '--no-pager',
+              '--identifier', $identifier, '-n', 5000];
+
+    if (defined($rbl_scan_last_cursor)) {
+       push @$cmd, "--after-cursor=${rbl_scan_last_cursor}";
+    } else {
+       push @$cmd, "--since=@" . $rbl_scan_start_time;
+    }
+
+    PVE::Tools::run_command($cmd, outfunc => $parser);
+
+    return ($rbl_count, $pregreet_count);
+}
+
+my $hwaddress;
+
+sub get_hwaddress {
+
+    return $hwaddress if defined ($hwaddress);
+
+    my $fn = '/etc/ssh/ssh_host_rsa_key.pub';
+    my $sshkey = PVE::Tools::file_get_contents($fn);
+    $hwaddress = uc(Digest::MD5::md5_hex($sshkey));
+
+    return $hwaddress;
+}
+
+my $default_locale = "en_US.UTF-8 UTF-8";
+
+sub cond_add_default_locale {
+
+    my $filename = "/etc/locale.gen";
+
+    open(my $infh, "<", $filename) || return;
+
+    while (defined(my $line = <$infh>)) {
+       if ($line =~ m/^\Q${default_locale}\E/) {
+           # already configured
+           return;
+       }
+    }
+
+    seek($infh, 0, 0) // return; # seek failed
+
+    open(my $outfh, ">", "$filename.tmp") || return;
+
+    my $done;
+    while (defined(my $line = <$infh>)) {
+       if ($line =~ m/^#\s*\Q${default_locale}\E.*/) {
+           print $outfh "${default_locale}\n" if !$done;
+           $done = 1;
+       } else {
+           print $outfh $line;
+       }
+    }
+
+    print STDERR "generation pmg default locale\n";
+
+    rename("$filename.tmp", $filename) || return; # rename failed
+
+    system("dpkg-reconfigure locales -f noninteractive");
+}
+
 1;