forken in perl

26 Dec 2003

      Anmerkung: Diese Mail sollte seit fast einem Tag bereits in der Liste
sein, ist aber, auch laut
http://marc.theaimsgroup.com/?l=suse-programming&r=1&b=200312&w=2 nicht
angekommen. Ich poste nochmal. Laut obiger Adresse ist es auch recht
selten, daß 3 Tage lang keine einzige Mail in dieser Liste auftaucht.
Vieleicht klemmte da was, denn heute kam auch von jemand anders wieder
was (eclipse + cvs)

Hallo,

Ich komme da bei einer Sache nicht weiter...

Ich bastele wieder an meiner Fontsammlung rum, und wie gehabt gibt es
das Problem, dass ein beschädigter Font mein Perlscript per Segfault
crashen kann. Ich möchte aber das Script weiterlaufen lassen.

Ich habe hier den Tip bekommen, daß das Abfangen von Segfault-Signalen
unsauber wäre, da der Prozess sich in einem mehr oder weniger
undefinierten Zustand befände. Besser wäre es, einen separaten Prozess
zu nutzen, und den wenn der wegbricht, ihn in Frieden sterben zu lassen
und einen neuen Prozess zu starten. Joo... klingt gut. Krieg ich aber
nicht hin.

Hier mal etwas Pseudocode:

fork()

if parent
  gib_child_kommandos()
  if (child weggebrochen) fork nochmal
  if ich_bin_plötzlich_child: raus hier  # Könnte wg. fork passieren
endif

if child
  höre auf parent, führe dessen kommandos aus
  simuliere_crash	# mit chance von 30%
endif

Soweit die Theorie. In der Praxis funktioniert das prima, bis
tatsächlich ein Fehler im Child-Block auftritt. Derzeit simuliere ich
das einfach über ein "die" mit 30%-Chance.
Es scheint, als würde ein "die" im Child auch den Parent sofort beenden.
Verstehe ich nicht. Steht in der Doku anders.

Geguckt habe ich bisher in der perldoc unter perlipc und perlfork, große
Teile des Scriptes sind den Beispielen dort entnommen.

Ich füge das Script mal bei. Danke für eure Hilfe!

Gruß, Ratti

#!/usr/bin/perl -w

use warnings;
use strict;

use Socket;
use IO::Handle;	
use POSIX ":sys_wait_h";
use POSIX 'setsid';

# thousands of lines just for autoflush :-(
# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.

my ($pid,$line);
my ($kid,$parent);
new_socket();
my $kid_pid = fork_kid();

if ( $parent ) {
	#parent
	my $alive;
	for ( my $i=0 ; ( $i<20 ) && ( $kid == 0) ; $i++) {
		$alive=kid_alive($kid_pid);
		if ($alive) {
			print CHILD "DO\n";
		} else {
			new_socket();
			$kid_pid=fork_kid();
		}
		sleep 1;
	}
	# maybe we forked because kid died,
	# so "kid" can occur in parent process.
	# Get out here, go kid.
	if ( $parent ) {	
		print "died as parent\n";
		print CHILD "DIE\n";
		waitpid($kid_pid,0);
	}
	if ( $kid ) {
		print "died as kid\n";
	}
}

if ($kid) {
	#child
	while (1) {
		$line = <PARENT>;
		chomp $line;
		if ( $line eq "HELLO" ) {
					print PARENT "SMACK\n";
		}
		if ( $line eq "DO" ) {
			if ( int(rand(100)) < 30 ) {  die "e\n"; }
		}
		if ( $line eq "DIE" ) {
					close PARENT;
					exit;
		}
	}
}  

sleep 4;

sub fork_kid {
	$pid = fork;
	if ($pid != 0) {
		#parent
		close PARENT;
		$parent=-1;
		$kid=0;
		return $pid;
	} else {
		#kid
		die "cannot fork: $!" unless defined $pid;
		close CHILD;
		setsid or die "Can't start a new session: $!";
		$parent=0;
		$kid=-1;
		return 0;
	}
}

sub kid_alive {
	my $pid=shift;
	if (! defined $pid ) { return 0; }
	# Undefined pid: Never forked before

	my $kid = waitpid( $pid , WNOHANG);
	if ( $kid == -1 ) { return 0; }		
	# No such process

	# Found a(!) process. Is it the right one?
	print CHILD "HELLO\n";
	chomp(my $line = <CHILD>);
	if ( $line eq "SMACK" ) { return -1; }
	# Kid's alive and replies

	return 0;
	# Uh. Rang the wrong door, or kid's dead.
}

sub new_socket {
	socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
				or  die "socketpair: $!";
	CHILD->autoflush(1);
	PARENT->autoflush(1);
}

-- 
 -o)    fontlinge  | Font management for Linux  | Schriftenverwaltung in Linux
 /\\                                  http://freshmeat.net/projects/fontlinge/
_\_V    http://www.gesindel.de     https://sourceforge.net/projects/fontlinge/

Joerg Rossdeutscher

Andre Heine

Joerg Rossdeutscher

Andre Heine

Andre Heine

Andre Heine

Andre Heine

Andre Heine

Joerg Rossdeutscher

Andre Heine

Joerg Rossdeutscher

Ferdinand Ihringer

Thorsten Haude

Ferdinand Ihringer

Thorsten Haude

Andre Heine

Joerg Rossdeutscher

Andre Heine

Gerald Goebel

Gerald Goebel

Gerald Goebel

Joerg Rossdeutscher

Ferdinand Ihringer

Joerg Rossdeutscher

Thorsten Haude

Joerg Rossdeutscher

Gerald Goebel

Joerg Rossdeutscher

Gerald Goebel

Joerg Rossdeutscher

Gerald Goebel

Joerg Rossdeutscher

Gerald Goebel

Ferdinand Ihringer

Ferdinand Ihringer

Thorsten Haude

Ferdinand Ihringer

Ferdinand Ihringer

Thorsten Haude

Gerald Goebel

Joerg Rossdeutscher

Gerald Goebel

Joerg Rossdeutscher

Gerald Goebel

Christian Boltz

Thorsten Haude

Joerg Rossdeutscher

Thorsten Haude

jz

Joerg Rossdeutscher

tags

participants (9)