Perl

DBD/DBI：如果程序被分叉，則崩潰

  • January 5, 2016

如果未設置 $crash 參數，則以下程序有效：

$ perl example mysql://:tange@/tange/mytable
dburl mysql://:tange@/tange/mytable
databasedriver mysql user  password tange host  port  database tange table mytable query 
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
               (Seq INT,
                Exitval INT
                );
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);

如果設置了 $crash，bzip2 將通過 open3 執行，數據通過分叉程序發送，這會使 DBD/DBI 崩潰：

$ perl example mysql://:tange@/tange/mytable 1
dburl mysql://:tange@/tange/mytable
databasedriver mysql user  password tange host  port  database tange table mytable query 
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
               (Seq INT,
                Exitval INT
                );
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
Orig:
As bzip2:BZh9rE8P�
1
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
DBD::mysql::st execute failed: MySQL server has gone away at example line 157.
DBD::mysql::st execute failed: MySQL server has gone away at example line 157.

如果使用 Postgresql，這也是正確的：

$ perl example pg:////mytable 
dburl pg:////mytable
databasedriver pg user  password  host  port  database  table mytable query 
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
               (Seq INT,
                Exitval INT
                );
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);

並設置了 $crash：

$ perl example pg:////mytable 1
dburl pg:////mytable
databasedriver pg user  password  host  port  database  table mytable query 
run DROP TABLE IF EXISTS mytable;
run CREATE TABLE mytable
               (Seq INT,
                Exitval INT
                );
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
Orig:
As bzip2:BZh9rE8P�
1
run INSERT INTO mytable (Seq,Exitval) VALUES (?,?);
DBD::Pg::st execute failed: server closed the connection unexpectedly
       This probably means the server terminated abnormally
       before or while processing the request. at example line 157.
DBD::Pg::st execute failed: server closed the connection unexpectedly
       This probably means the server terminated abnormally
       before or while processing the request. at example line 157.

為什麼？有解決方法嗎？

對我來說 open3 和 fork 與 DBD/DBI 完全無關。

#!/usr/bin/perl

use IPC::Open3;

my $sql = SQL->new(shift);
my $crash = shift;
$Global::debug = "all";
$sql->create_table();
$sql->insert_records(2);
$crash and print length string_zip("abc"),"\n";
$sql->insert_records(3);

sub string_zip {
   # Pipe string through 'cmd'
   my $cmd = shift;
   my($zipin_fh, $zipout_fh,@base64);
   ::open3($zipin_fh,$zipout_fh,">&STDERR","bzip2 -9");
   if(fork) {
   close $zipin_fh;
   @base64 = <$zipout_fh>;
   close $zipout_fh;
   } else {
   close $zipout_fh;
   print $zipin_fh @_;
   close $zipin_fh;
   exit;
   }
   ::debug("zip","Orig:@_\nAs bzip2:@base64\n");
   return @base64;
}

sub undef_if_empty {
   if(defined($_[0]) and $_[0] eq "") {
   return undef;
   }
   return $_[0];
}

sub debug {
   # Uses:
   #   $Global::debug
   #   %Global::fd
   # Returns: N/A
   print @_[1..$#_];
}

package SQL;

sub new {
   my $class = shift;
   my $dburl = shift;
   $Global::use{"DBI"} ||= eval "use DBI; 1;";
   my %options = parse_dburl($dburl);
   my %driveralias = ("sqlite" => "SQLite",
              "sqlite3" => "SQLite",
              "pg" => "Pg",
              "postgres" => "Pg",
              "postgresql" => "Pg");
   my $driver = $driveralias{$options{'databasedriver'}} || $options{'databasedriver'};
   my $database = $options{'database'};
   my $host = $options{'host'} ? ";host=".$options{'host'} : "";
   my $port = $options{'port'} ? ";port=".$options{'port'} : "";
   my $dsn = "DBI:$driver:dbname=$database$host$port";
   my $userid = $options{'user'};
   my $password = $options{'password'};;
   my $dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 })
   or die $DBI::errstr;
   return bless {
   'dbh' => $dbh,
   'max_number_of_args' => undef,
   'table' => $options{'table'},
   }, ref($class) || $class;
}

sub parse_dburl {
   my $url = shift;
   my %options = ();
   # sql:mysql://[[user][:password]@][host][:port]/[database[/table][?sql query]]

   if($url=~m!(?:sql:)? # You can prefix with 'sql:'
              ((?:oracle|ora|mysql|pg|postgres|postgresql)(?:s|ssl|)|
                (?:sqlite|sqlite2|sqlite3)):// # Databasedriver ($1)
              (?:
               ([^:@/][^:@]*|) # Username ($2)
               (?:
                :([^@]*) # Password ($3)
               )?
              @)?
              ([^:/]*)? # Hostname ($4)
              (?:
               :
               ([^/]*)? # Port ($5)
              )?
              (?:
               /
               ([^/?]*)? # Database ($6)
              )?
              (?:
               /
               ([^?]*)? # Table ($7)
              )?
              (?:
               \?
               (.*)? # Query ($8)
              )?
             !ix) {
   $options{databasedriver} = ::undef_if_empty(lc(uri_unescape($1)));
   $options{user} = ::undef_if_empty(uri_unescape($2));
   $options{password} = ::undef_if_empty(uri_unescape($3));
   $options{host} = ::undef_if_empty(uri_unescape($4));
   $options{port} = ::undef_if_empty(uri_unescape($5));
   $options{database} = ::undef_if_empty(uri_unescape($6));
   $options{table} = ::undef_if_empty(uri_unescape($7));
   $options{query} = ::undef_if_empty(uri_unescape($8));
   ::debug("sql","dburl $url\n");
   ::debug("sql","databasedriver ",$options{databasedriver}, " user ", $options{user},
         " password ", $options{password}, " host ", $options{host},
         " port ", $options{port}, " database ", $options{database},
         " table ",$options{table}," query ",$options{query}, "\n");

   } else {
   ::error("$url is not a valid DBURL");
   exit 255;
   }
   return %options;
}

sub uri_unescape {
   # Copied from http://cpansearch.perl.org/src/GAAS/URI-1.55/URI/Escape.pm
   # to avoid depending on URI::Escape
   # This section is (C) Gisle Aas.
   # Note from RFC1630:  "Sequences which start with a percent sign
   # but are not followed by two hexadecimal characters are reserved
   # for future extension"
   my $str = shift;
   if (@_ && wantarray) {
   # not executed for the common case of a single argument
   my @str = ($str, @_);  # need to copy
   foreach (@str) {
       s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
   }
   return @str;
   }
   $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
   $str;
}

sub run {
   my $self = shift;
   my $stmt = shift;
   my $dbh = $self->{'dbh'};
   ::debug("sql","run $stmt\n");
   # Execute with the rest of the args - if any
   my $rv;
   my $sth;
   $sth = $dbh->prepare($stmt);
   $rv = $sth->execute(@_);
   return $sth;
}

sub table {
   my $self = shift;
   return $self->{'table'};
}

sub create_table {
   my $self = shift;
   my $table = $self->table();
   $self->run(qq(DROP TABLE IF EXISTS $table;));
   $self->run(qq{CREATE TABLE $table
       (Seq INT,
        Exitval INT
        }.
          qq{);});
}

sub insert_records {
   my $self = shift;
   my $seq = shift;
   my $record_ref = shift;
   my $table = $self->table();
   $self->run("INSERT INTO $table (Seq,Exitval) ".
          "VALUES (?,?);", $seq, -1000);
}

當子程序或父程序退出時，它會關閉其數據庫句柄和關聯的套接字，並且在伺服器端，相應的後端也會退出。

從那時起，如果其他（仍然存在的）客戶端程序嘗試使用數據庫句柄，發送查詢將失敗，MySQL 伺服器已消失或 postgres伺服器意外關閉連接。這些消息似乎非常正確地描述了發生的事情。

主要的解決方法是呼叫DBI->connect()之後fork而不是以任何方式在程序之間共享數據庫句柄。

如果數據庫活動僅限於父級，您可以AutoInactiveDestroy提前設置數據庫句柄（從 DBI 1.614 開始）。這應該InactiveDestroy在孩子中自動設置並解決問題。請參閱InactiveDestroyDBI 文件：

對於數據庫句柄，此屬性不會禁用對斷開連接方法的顯式呼叫，只會禁用來自 DESTROY 的隱式呼叫，如果句柄仍標記為活動，則會發生這種呼叫。

此屬性專門設計用於“派生”子程序的 Unix 應用程序。對於某些驅動程序，當子程序退出時，繼承句柄的銷毀會導致父程序中相應的句柄停止工作。

父程序或子程序中的任何一個（而不是兩者）都應在其所有共享句柄上將 InactiveDestroy 設置為 true。或者，並且優選地，可以在連接時在父級中設置“AutoInactiveDestroy”。

引用自：https://unix.stackexchange.com/questions/252596

相關問答

Perl

最大化數據集的覆蓋範圍

  • October 16, 2019
檢視問答
Debian

perl 在 debian 中寫了多少程式碼？

  • October 15, 2022
檢視問答
Regular-Expression

如何將多個正則表達式壓縮為單行？

  • August 25, 2022
檢視問答
Shell

clusterssh：防止視窗按字母順序排列

  • August 24, 2022
檢視問答
Perl

Perl：s的速度///

  • July 31, 2022
檢視問答
Sed

使用 perl 進行條件替換

  • June 11, 2022
檢視問答