[prev in list] [next in list] [prev in thread] [next in thread]
List: drbd-cvs
Subject: [DRBD-cvs] svn commit by phil - r2239 - in trunk/testing: .
From: drbd-cvs () linbit ! com
Date: 2006-06-20 15:15:53
Message-ID: 20060620151553.4F8842D99C50 () mail ! linbit ! com
[Download RAW message or body]
Author: phil
Date: 2006-06-20 17:15:48 +0200 (Tue, 20 Jun 2006)
New Revision: 2239
Added:
trunk/testing/testsuite/
trunk/testing/testsuite/COMMUNICATION
trunk/testing/testsuite/INSTALL
trunk/testing/testsuite/README
trunk/testing/testsuite/agent.conf
trunk/testing/testsuite/agent.pl
trunk/testing/testsuite/conf/
trunk/testing/testsuite/conf/test1.conf
trunk/testing/testsuite/conf/test2.conf
trunk/testing/testsuite/conf/test3.conf
trunk/testing/testsuite/conf/test4.conf
trunk/testing/testsuite/tests/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/Changes
trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.bs
trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.c
trunk/testing/testsuite/tests/LinuxRealTime-0.01/MANIFEST
trunk/testing/testsuite/tests/LinuxRealTime-0.01/META.yml
trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile
trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile.PL
trunk/testing/testsuite/tests/LinuxRealTime-0.01/README
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/LinuxRealTime.bs
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/LinuxRealTime.so
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/bin/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/bin/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/LinuxRealTime.pm
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/auto/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/auto/LinuxRealTime/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/auto/LinuxRealTime/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man1/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man1/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/LinuxRealTime.3pm
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/script/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/script/.exists
trunk/testing/testsuite/tests/LinuxRealTime-0.01/lib/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/lib/LinuxRealTime.pm
trunk/testing/testsuite/tests/LinuxRealTime-0.01/pm_to_blib
trunk/testing/testsuite/tests/LinuxRealTime-0.01/t/
trunk/testing/testsuite/tests/LinuxRealTime-0.01/t/LinuxRealTime.t
trunk/testing/testsuite/tests/LinuxRealTime.pm
trunk/testing/testsuite/tests/LinuxRealTime.so
trunk/testing/testsuite/tests/README
trunk/testing/testsuite/tests/caller.pl
trunk/testing/testsuite/tests/eval.pl
trunk/testing/testsuite/tests/eval2.pl
trunk/testing/testsuite/tests/receiver.pl
trunk/testing/testsuite/tests/run.pl
trunk/testing/testsuite/testsuite.conf
trunk/testing/testsuite/testsuite.pl
Log:
Initial import of the new testsuite.
Added: trunk/testing/testsuite/COMMUNICATION
===================================================================
--- trunk/testing/testsuite/COMMUNICATION 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/COMMUNICATION 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,87 @@
+This document explains the internal communication between the Testsuite and the
+Agents of the DRBDv8 TestSuite.
+
+Verion 1.0
+ This document is correct for version 1.0 of the Testsuite.
+
+Written by: Dworschak, Roland <roland.dworschak@fh-hagenberg.at>
+ Hofmann, Florian <florian.hofmann@fh-hagenberg.at>
+ Huber, Sabine <sabine.huber@fh-hagenberg.at>
+ Leitner, Alexander <alexander.leitner@fh-hagenberg.at>
+ Poettinger, Joachim <joachim.poettinger@fh-hagenberg.at>
+
+
+=====================
+=== COMMUNICATION ===
+=====================
+
+== Sending replies:
+
+Agent -> Testsuite:
+<success> <timestamp> <execution time>
+<output>
+.
+
+success
+ is either 0 (failed, timed out, other state than expected) or
+ 1 (everything ok).
+
+timestamp
+ local timestamp of the Agent (might be 0).
+
+execution time
+ time needed to execute requested command (might be 0).
+
+output
+ output of the requested command. A single point in a new line signals
+ the end of the reply.
+
+
+== Sending commands:
+
+* setup:
+
+ used to test latency of the Agents and to get the time difference of
+ both Agents.
+
+Testsuite -> Agent:
+setup(<timestamp>);
+
+Agent -> Testsuite:
+1 0 0
+<timestamp> <time difference>;
+
+timestamp
+ local timestamp of the Testsuite or the Agent.
+
+time difference
+ difference of received timestamp and local timestamp.
+
+
+
+* execute:
+
+ used to execute given commands by cmd, expected and get.
+
+Testsuite -> Agent:
+execute(<command>, <timeout>, <timestamp>[, state]);
+
+Agent -> Testsuite:
+<success> <timestamp> <execution time>
+$output
+.
+
+
+
+* send_log:
+
+ used to get logs (specified in agent.conf) of the Agent.
+
+Testsuite -> Agent:
+send_log();
+
+Agent -> Testsuite:
+1 0 0
+$log
+.
+
Added: trunk/testing/testsuite/INSTALL
===================================================================
--- trunk/testing/testsuite/INSTALL 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/INSTALL 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,94 @@
+This document explains how the DRBD Testsuite has to be installed.
+
+Verion 1.0
+ This document is correct for version 1.0 of the Testsuite.
+
+Written by: Dworschak, Roland <roland.dworschak@fh-hagenberg.at>
+ Hofmann, Florian <florian.hofmann@fh-hagenberg.at>
+ Huber, Sabine <sabine.huber@fh-hagenberg.at>
+ Leitner, Alexander <alexander.leitner@fh-hagenberg.at>
+ Poettinger, Joachim <joachim.poettinger@fh-hagenberg.at>
+
+
+
+==================
+== REQUIREMENTS ==
+==================
+
+
+Perl 5.6 (or higher)
+ Perl is a language optimized for scanning arbitrary text files,
+ extracting information from those text files, and printing reports
+ based on that information.
+ The Perl module is needed, because Agents and Testsuite files are
+ written as Perl scripts.
+
+
+Time::HiRes
+ This mdoule implements an interface to high resolution time and timers
+ like "usleep".
+
+ perl -MCPAN -e shell
+ install Time::HiRes
+
+
+Time::Local
+ This module implements the inverse of the built-in perl functions local-
+ time and gmtime. It is used to convert a timestamp to UTC format.
+
+ perl -MCPAN -e shell
+ install Time::Local
+
+
+IO::Socket
+ Provides an object interface to create and use sockets.
+
+ perl -MCPAN -e shell
+ install IO::Socket
+
+
+=============
+== INSTALL ==
+=============
+
+
+1.) Unpack the testsuite.tar.gz to any directory.
+
+ $ tar -xzvf testsuite.tar.gz
+
+== on both drbd nodes ==
+
+2a.) Edit agent.conf according to your system configuration:
+ - interface on which drbd is connected
+ - ip address on which the Agent is connected
+ - port on which the Agent is listening
+ - drbd resource which should be used
+ - mountpoint of the drbd device
+ - drbd device which shoud be used
+
+ Example given in agent.conf
+
+3a.) Start agent.pl on each Agent. If you want the Agent to run in realtime
+ (priority scheduling), you need root privileges.
+
+ $ ./agent.pl
+
+
+== on the Testsuite client ==
+
+2b.) Edit testsuite.conf according to your system configuration:
+ - Node configuration (address and port)
+ - Seq_commands
+ - Default values (timeout, latency, timeserver)
+
+ Example given in testsuite.conf
+
+
+== testing procedure ==
+
+4.) Now you are ready to start the Testsuite.
+
+ $ ./testsuite.pl -v
+
+
+
Added: trunk/testing/testsuite/README
===================================================================
--- trunk/testing/testsuite/README 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/README 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,246 @@
+"DRBD Testsuite" is designed to test the actual DRBDv8 release and to simplify
+the testing procedure with predefined configuration files. It is a powerful and
+easy to use tool.
+
+Agents are used to execute and verify the given commands on a node of the DRBD
+cluster. The Testsuite runs on a seperated client (or one of the nodes) and
+includes all configuration files and the commands, that should be executed.
+
+For further information about configuration read agent.conf and testsuite.conf.
+Take a look at INSTALL for installation steps. If you want to know more about
+the code of the Testsuite, also read COMMUNICATION.
+
+Version 1.0
+ This document is correct for version 1.0 of the DRBD Testsuite.
+
+Written by: Dworschak, Roland <roland.dworschak@fh-hagenberg.at>
+ Hofmann, Florian <florian.hofmann@fh-hagenberg.at>
+ Huber, Sabine <sabine.huber@fh-hagenberg.at>
+ Leitner, Alexander <alexander.leitner@fh-hagenberg.at>
+ Poettinger, Joachim <joachim.poettinger@fh-hagenberg.at>
+
+
+======================
+= MODES OF OPERATION =
+======================
+
+./agent.pl
+
+-h show help
+
+-D Don't daemonize
+ Runs agent in foreground
+
+-c <config>
+ Specify a configuration file other than the default (./agent.conf)
+
+
+
+
+
+./testsuite.pl
+
+-h show help
+
+-c <config>
+ Specify a configuration file other than the default configuration file
+
+-i ignore time difference on agents
+ Testsuite will not try to syncronize the agents if they are out of sync,
+ the testing procedure continues even if the maximum time difference is
+ exceeded.
+
+-v verbose mode
+ Show detailed information about the testing procedure.
+
+-d Debug mode
+ Detailed output on console
+
+-l <logfile>
+ Writes all information to specified logfile.
+
+
+
+=================================
+= CONFIGURATION OF SEQ_COMMANDS =
+=================================
+
+All seq_commands, which should be executed, have to be configured in
+testsuite.conf. There are also some predefined commands, that can be found at
+the beginning of the testsuite.pl. It is also possible to execute common perl
+commands like while, if, for, ...
+
+
+== execute remote command:
+
+Synopsis:
+
+ cmd '<command>'[, on <nodeName>][, timeout <secs>][, rc <microseconds>];
+ cmd <argument>[, on <nodeName>][, timeout <secs>][, rc <microseconds>];
+
+
+cmd '<command>'
+ execute command.
+
+
+cmd <argument>
+ execute specified argument.
+
+
+on <nodeName>
+ send request to given node. If no node is given, both nodes will be
+ contacted.
+
+
+timeout <secs>
+ time given for execution in seconds - if the time runs out,
+ there'll be a message displayed on the testsuite
+
+
+rc <microseconds>
+ if rc is 0, execution will be immediately, otherwise the command will
+ be executed in <microseonds> from now on. Use rc in ms range (> 1000)
+ if you want commands to be executed simultaneously.
+
+__
+Return Value:
+ Returns true or false as if the command was successfully executed or
+ timed out.
+
+__
+Example:
+ cmd 'drbdadm create-md r0', on node1, timeout 10, rc 15000
+
+ tries to run 'drbdadm create-md r0' on node1 in 15 ms for no longer
+ than 10 seconds.
+
+-------------------------------------------------------------------------
+
+== sleep/wait for <n> seconds:
+
+Synopsis:
+
+ sleep <secs>;
+
+
+sleep <secs>
+ testsuite sleeps for <secs> seconds.
+
+__
+Return Value
+ Returns the number of seconds actually slept.
+
+__
+Example:
+ sleep 15;
+
+ the next command will be processed in 15 seconds.
+
+-------------------------------------------------------------------------
+
+== Test expected state:
+
+Synopsis:
+
+ expected '<type>', state '<state>'[, on <nodeName>][, timeout <secs>][, rc \
<microseconds>]; +
+
+expected
+ Indicator for request
+
+
+<type>
+ Available types (defined in $commands{state_XX}):
+ cs ... Connection state
+ ds ... Local data storage
+ st ... Peer state
+
+state <state>
+ Expected state on node:
+ cs: StandAlone st: Unknown
+ Unconnected Primary
+ Timeout Secondary
+ BrokenPipe role_mask
+ NetworkFailure DontBlameDrbd
+ WFConnection
+ WFReportParams
+ TearDown
+ Connected ds: Diskless
+ SkippedSyncS Failed
+ SkippedSyncT Attaching
+ WFBitMapS Inconsistent
+ WFBitMapT Outdated
+ SyncSource DUnknown
+ SyncTarget Consistent
+ PausedSyncS UpToDate
+ PausedSyncT
+
+
+on <nodeName>
+ send request to given node. If no node is given, both nodes will be
+ contacted.
+
+
+timeout <secs>
+ within this time the type has to change to the expected one.
+
+rc <microseconds>
+ if rc is 0, execution will be immediately, otherwise the command will
+ be executed in <microseonds> from now on. Use rc in ms range (> 1000)
+ if you want commands to be executed simultaneously.
+
+
+__
+Return Value:
+ Returns true or false as if the expected state was reached within the
+ timeout or not.
+
+
+__
+Example:
+ expected 'cs', state 'Connected', on node1, timeout 10;
+
+ Check if connection state is Connected within 10 seconds on node1.
+
+
+-------------------------------------------------------------------------
+
+== Get command
+
+Synopsis:
+
+ get '<command>',[, on <nodeName>][, timeout <secs>][, rc <microseconds>];
+ get <argument>[, on <nodeName>][, timeout <secs>][, rc <microseconds>];
+
+
+get <argument>
+get '<command>'
+ get specified information
+
+
+on <nodeName>
+ send request to given node. If no node is given, both nodes will be
+ contacted.
+
+
+timeout <secs>
+ time given for execution in seconds - if the time runs out,
+ there'll be a message displayed on the testsuite
+
+
+rc <microseconds>
+ if rc is 0, execution will be immediately, otherwise the command will
+ be executed in <microseonds> from now on. Use rc in ms range (> 1000)
+ if you want commands to be executed simultaneously.
+
+__
+Return Value:
+ Returns false in case of timeout otherwise output of the command
+
+__
+Example:
+ get 'cat /proc/drbd', on node1;
+
+ shows according to the requested command the output of cat /proc/drbd
+ of node 1.
+
Added: trunk/testing/testsuite/agent.conf
===================================================================
--- trunk/testing/testsuite/agent.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/agent.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,61 @@
+# Configuration file of agent.pl
+#
+# Used to configure the agents
+# Important: after each argument put ; to finish the line otherwise it will not be \
set and can cause errors! +
+
+# interface on which drbd is connected
+# Syntax: interface <i>
+# If this is left undefined the agent will not start.
+#
+# Example: interface eth0;
+#
+interface eth1;
+
+# ip address on which the agent is connected
+# Syntax: addr <ip>
+# If this is left undefined the agent will not start.
+#
+# Example: addr 192.168.1.42;
+#
+addr 0.0.0.0;
+
+# port on which the agent is listening
+# Syntax: port <p>
+# If this is left undefined the agent will not start.
+#
+# Example: port 4000;
+#
+port 4000;
+
+# drbd resource which should be used
+# Syntax: resource <r>
+# If this is left undefined the agent will not start.
+#
+# Example: resource r0;
+#
+resource r0;
+
+# mountpoint of the drbd device
+# Syntax: mountpoint <mp>
+# If this is left undefined the agent will not start.
+#
+# Example: mountpoint /extern/drbd0;
+#
+mountpoint /extern/drbd0;
+
+# drbd device which shoud be used
+# Syntax: device <d>
+# If this is left undefined the agent will not start.
+#
+# Example: device drbd0;
+#
+device drbd0;
+
+# logfile to parse
+# Syntax: logfile <log>
+# If this is left undefined the agent will not start.
+#
+# Example: logfile /var/log/messages;
+#
+logfile /var/log/messages;
Added: trunk/testing/testsuite/agent.pl
===================================================================
--- trunk/testing/testsuite/agent.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/agent.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,463 @@
+#!/usr/bin/perl -W
+
+# agent
+#
+# Part of the DRBD TestSuite
+#
+# (c)2006 by Dworschak, Roland <roland.dworschak@fh-hagenberg.at>
+# Hofmann, Florian <florian.hofmann@fh-hagenberg.at>
+# Huber, Sabine <sabine.huber@fh-hagenberg.at>
+# Leitner, Alexander <alexander.leitner@fh-hagenberg.at>
+# Poettinger, Joachim <joachim.poettinger@fh-hagenberg.at>
+#
+# Licensed under the GNU GPL v2
+# see http://www.gnu.org for more details
+#
+
+my $version = 'v1.00';
+
+use strict;
+use Time::HiRes qw(usleep gettimeofday tv_interval);
+use Time::Local;
+use IO::Socket;
+
+# set rtprio to 99 (for testing purpose: 50)
+require 'sys/syscall.ph';
+eval {
+ syscall(&SYS_sched_setscheduler,0,1,pack('i', 50)) == 0 or die ($!."\n");
+};
+if ($@) {
+ die unless $@ eq "Operation not permitted\n";
+ WARN ("Couldn't set realtime scheduler, are you root?");
+}
+
+eval {
+ syscall(&SYS_mlockall, 3) == 0 or die ($!."\n");
+};
+if ($@) {
+ die unless $@ eq "Cannot allocate memory\n";
+ WARN ("Couldn't set mlockall, are you root?");
+}
+
+
+# program variables
+use vars qw (
+ %config
+ $opt_h $opt_c $opt_d $opt_D
+ $client $sock
+ $log_timestamp
+);
+
+require 'getopts.pl';
+if ( ! Getopts ('hdDc:') ) {
+ usage();
+ exit 1;
+}
+
+if (defined($opt_h)) {
+ usage();
+ exit 0;
+}
+
+if (defined($opt_d)) {
+ print "DEBUG MODE not implemented yet - only OUTPUT!\n";
+}
+
+# show usage information
+sub usage {
+ print "TestSuite $version \n";
+ print "agent.pl [ -hdD ] [ -c config ]\n";
+ print " -h shows help\n";
+ print " -d run in debug mode (not implemented - only OUTPUT)\n";
+ print " -D don't daemonize, run in foreground\n";
+ print " -c specifiy a configuration file other than the default (agent.conf)\n";
+}
+
+
+###############################################################################
+###### functions
+###############################################################################
+
+# setup information (system time, latency, ...)
+sub setup {
+ my ($testsuite_timestamp) = @_;
+ my $timestamp = Time::HiRes::time;
+
+ send_reply(1, 0, 0, $timestamp. " " .($timestamp - $testsuite_timestamp));
+ return;
+}
+
+sub load_conf {
+ if (!defined($opt_c)) {
+ $opt_c = "agent.conf";
+ }
+ if (! -e $opt_c) {
+ ERROR ("Configuration file not available!\n");
+ }
+ open (CONF, $opt_c) or ERROR ("Cannot read the config file $opt_c, $!\n");
+
+ # initiate variables
+ $config{'interface'} = "";
+ $config{'addr'} = "";
+ $config{'port'} = "";
+ $config{'resource'} = "";
+ $config{'mountpoint'} = "";
+ $config{'device'} = "";
+ $config{'logfile'} = "";
+ while (<CONF>) {
+ next if (/^\s*$/); # skip blank lines
+ next if (/^\s*#/); # skip comment lines
+ $_ = trim($_);
+
+ if (/interface\s+(.*);/) {
+ $config{'interface'} = $1;
+ }
+ elsif (/addr\s+(.*);/) {
+ $config{'addr'} = $1;
+ }
+ elsif (/port\s+(.*);/) {
+ $config{'port'} = $1;
+ }
+ elsif (/resource\s+(.*);/) {
+ $config{'resource'} = $1;
+ }
+ elsif (/mountpoint\s+(.*);/) {
+ $config{'mountpoint'} = $1;
+ }
+ elsif (/device\s+(.*);/) {
+ $config{'device'} = $1;
+ }
+ elsif (/logfile\s+(.*);/) {
+ $config{'logfile'} = $1;
+ }
+ else {
+ ERROR ("Unknown configuration settings: ".$_);
+ }
+ }
+
+}
+
+###############################################################################
+###### functions
+###############################################################################
+
+
+# tests configuration variables. currently only permissions to open
+# the logfile is tested.
+sub test_conf {
+ my $fh;
+
+ if (defined($config{'logfile'})) {
+ eval {
+ open($fh, $config{'logfile'}) or die ($!."\n");
+ };
+ if ($@) {
+ if ($@ eq "Permission denied\n") {
+ WARN ("No permission to read logfile: ".$config{'logfile'});
+ }
+ else {
+ ERROR ($@);
+ }
+ }
+ }
+
+ close $fh;
+
+ #if ($config{'interface'} eq ""){
+ # print "Warning! interface is undefined!\n";
+ #}
+ #if ($config{'addr'} eq ""){
+ # print "Warning! address is undefined!\n";
+ #}
+ #if ($config{'port'} eq ""){
+ # print "Warning! port is undefined!\n";
+ #}
+ #if ($config{'resource'} eq ""){
+ # print "Warning! drbd-resource is undefined!\n";
+ #}
+ #if ($config{'mountpoint'} eq ""){
+ # print "Warning! mountpoint is undefined!\n";
+ #}
+
+ return;
+}
+
+# parses through command and changes marked keys
+sub parse_command {
+ my ($command) = @_;
+ my $key;
+ my $value;
+
+ while (($key, $value) = each(%config)) {
+ $$command =~ s/{$key}/$value/g;
+ }
+
+ return 1;
+}
+
+# execute requested command
+sub execute {
+ my ($command, $timeout, $timestamp, $expected) = @_;
+ my $sleeptime;
+ my $output;
+
+ parse_command(\$command);
+ $sleeptime = get_sleep_duration($timestamp);
+
+ # wait for given timestamp
+ usleep($sleeptime);
+
+ my $start_time = Time::HiRes::time;
+
+ eval {
+ local $SIG{ALRM} = sub { die "timeout\n" };
+ alarm $timeout;
+ do {
+ $output = `$command 2>&1`;
+ chomp($output);
+ } while (defined($expected) && !($output eq $expected));
+ alarm 0;
+ };
+ if ($@) {
+ # exceptions
+ die unless $@ eq "timeout\n";
+ $output = (defined($expected) && defined($output))?$output:'timeout';
+ }
+
+ my $execution_time = Time::HiRes::time - $start_time;
+
+ send_reply((($output ne 'timeout') && (!defined($expected) || ($output eq \
$expected)))?1:0, $start_time, $execution_time, $output); +}
+
+# send reply to testsuite
+sub send_reply {
+ my ($success, $start_time, $execution_time, $output) = @_;
+
+ if ($execution_time == 0) {
+ usleep(1000000);
+ }
+
+ #generate reply
+ #ErrorTag
+ my $reply = $success;
+ #cmd - ain't needed, never asked
+ #$reply .= " '".$command."'";
+ #Timestamp
+ $reply .= " ".$start_time;
+ #Execution_Time
+ $reply .= " ".$execution_time."\n";
+ #Output
+ $reply .= $output;
+ #end-tag
+ $reply .= "\n.\n"; #signalizes end of output
+
+ #send response
+ print $client $reply;
+}
+
+sub send_log {
+ if (!defined($config{'logfile'})) {
+ send_reply(0,0,0, 'logfile has not be specified in config.');
+ return 1;
+ }
+
+ my @varlog;
+ my $varlog_out = "";
+
+ my $logtime = 0;
+ my $found = 0;
+ my $firstcounter = 0;
+
+ my %mnames = (Jan => 0, Feb => 1, Mar => 2, Apr => 3,
+ May => 4, Jun => 5, Jul => 6, Aug => 7,
+ Sep => 8, Oct => 9, Nov => 10, Dec => 11);
+
+ my $date = `date | awk \'{ print \$6 }\'`;
+
+ # try to open file
+ eval {
+ open(LOGFILE, $config{'logfile'}) or die ($!."\n");
+ };
+ if ($@) {
+ send_reply(0,0,0,"Error reading logfile: ".$@);
+ return 1;
+ }
+
+ @varlog = <LOGFILE>;
+
+ foreach (@varlog) {
+ next if (/^\s*$/);
+
+ if (/^([a-zA-Z]{3})\ +([0-9]+)\ +([0-9]{2}):([0-9]{2}):([0-9]{2})\ +(.*)$/) {
+ $logtime = timegm($5,$4,$3,$2,$mnames{trim($1)},$date);
+
+ if ($log_timestamp <= $logtime) {
+ $varlog_out .= $_."\n";
+ }
+ }
+ }
+
+ close (LOGFILE);
+
+ if ($varlog_out eq "") {
+ send_reply(0,0,0,"No significant log.\n");
+ }
+ else {
+ send_reply(1,0,0,$varlog_out);
+ }
+
+ return 1;
+}
+
+###
+# help functions
+#
+
+
+# Return sleep duration for given timestamp
+sub get_sleep_duration {
+ my ($timestamp) = @_;
+ my $duration = 0;
+
+ $duration = $timestamp - Time::HiRes::time;
+
+ return ($duration > 0)?$duration:0;
+}
+
+# binds to local port
+sub get_socket {
+ eval {
+ $sock = new IO::Socket::INET (
+ LocalHost => $config{'addr'},
+ LocalPort => $config{'port'},
+ Proto => 'tcp',
+ Listen => 1,
+ Reuse => 1,
+ ) or die ($!."\n") unless $sock;
+ };
+ if ($@) {
+ ERROR ($@);
+ }
+}
+
+# handle log messages
+sub LOG {
+ my ($msg) = @_;
+ print "LOG: ".$msg."\n";
+}
+
+
+# run in background
+sub daemonize {
+ my ($home);
+ if (fork()) {
+ # parent
+ exit(0);
+ }
+ else {
+ # child
+ LOG "process id: $$";
+ $home = (getpwuid($>))[7] || die "No home directory!\n";
+ chdir($home); # go to my homedir
+ setpgrp(0,0); # become process leader
+ close(STDOUT);
+ close(STDIN);
+ close(STDERR);
+ }
+}
+
+# waits for requests by testsuite
+sub wait_for_request {
+ my $cmd = "";
+ #my $client;
+
+ while ($client = $sock->accept()) {
+ #LOG "waiting for connection";
+ LOG "got connection from ". $client->peerhost;
+ log_timestamp();
+ # as long as the testsuite's not closing the socket
+ while (<$client>)
+ {
+ eval($_);
+ #cmd ("cat /proc/cpuinfo |grep MH",10,Time::HiRes::time + 3_000_000); # 5 secs
+ }
+ }
+
+ LOG "got quit command.";
+ close($sock);
+}
+
+# get timestamp for log parsing in right form
+sub log_timestamp {
+
+ my %mnames = (Jan => 0, Feb => 1, Mar => 2, Apr => 3,
+ May => 4, Jun => 5, Jul => 6, Aug => 7,
+ Sep => 8, Oct => 9, Nov => 10, Dec => 11);
+
+ my $tmp = `date`;
+ my @date = split(/\s+/, $tmp);
+ my $cd = $date[2];
+ my $cm = $date[1];
+ my $ctime = $date[3];
+ my @ctime = split(/:/, $ctime);
+ my $y = $date[5];
+
+ $log_timestamp = timegm($ctime[2],$ctime[1],$ctime[0],$cd,$mnames{trim($cm)},$y);
+
+}
+
+
+###############################################################################
+###### help functions
+###############################################################################
+
+# handle warnings
+sub WARN {
+ my ($msg) = @_;
+ print "WARN: ". $msg."\n";
+}
+
+# print error messages
+sub ERROR {
+ my ($msg) = @_;
+ print "ERROR: ".$msg."\n";
+ exit 1;
+}
+
+# remove whitespaces at the beginning and at the end
+sub trim($) {
+ my $string = shift;
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+ return $string;
+}
+
+
+###############################################################################
+###### testing stuff
+###############################################################################
+
+sub test {
+ print "\nPRINT:\n";
+ print "Agent interface: $config{'interface'}\n";
+ print "Agent address: $config{'addr'}\n";
+ print "Agent port: $config{'port'}\n";
+ print "Agent drbd-resource: $config{'resource'}\n";
+ print "Agent mountpoint: $config{'mountpoint'}\n";
+ print "Agent drbd-device: $config{'device'}\n";
+}
+
+
+###############################################################################
+###### main
+###############################################################################
+
+load_conf;
+test_conf;
+get_socket;
+if (!defined($opt_D)) {
+ daemonize;
+}
+wait_for_request;
+
+exit 0;
Property changes on: trunk/testing/testsuite/agent.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/conf/test1.conf
===================================================================
--- trunk/testing/testsuite/conf/test1.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/conf/test1.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,36 @@
+#
+# test1.conf
+#
+# test 'outdate peer' mechanism
+#
+
+node node1 {
+ addr 10.25.91.10;
+ port 4000;
+}
+
+node node2 {
+ addr 10.25.91.11;
+ port 4000;
+}
+
+defaults {
+ timeout 30;
+ latency 0.05;
+}
+
+seq-commands {
+ cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi {resource}', rc 0;
+ cmd 'drbdadm up {resource}', rc 0;
+ expected 'cs', state 'Connected', timeout 10;
+ cmd 'drbdadm primary {resource}', on node1, rc 0;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+ sleep 2;
+
+ cmd link_down, rc 0;
+ expected 'cs', state 'WFConnection', timeout 10;
+ sleep 4;
+
+ cmd 'drbdadm primary {resource}', on node2, rc 20;
+}
+
Added: trunk/testing/testsuite/conf/test2.conf
===================================================================
--- trunk/testing/testsuite/conf/test2.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/conf/test2.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,33 @@
+# testcase_1
+# set both nodes secondary and afterwards both nodes primary (at the same time)
+
+node node1 {
+ addr 10.25.91.10;
+ port 4000;
+}
+
+node node2 {
+ addr 10.25.91.11;
+ port 4000;
+}
+
+defaults {
+ timeout 30;
+ latency 0.05;
+}
+
+seq-commands {
+ cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi {resource}', rc 0;
+ cmd 'drbdadm up {resource}', rc 0;
+ expected 'cs', state 'Connected', timeout 10;
+
+ cmd 'drbdadm secondary {resource}', rc 0;
+ expected 'st', state 'Secondary/Secondary', timeout 2;
+
+ sleep 2;
+
+
+ cmd 'drbdadm primary {resource}', rc 10;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+ expected 'st', on node2, state 'Secondary/Primary', timeout 2;
+}
\ No newline at end of file
Added: trunk/testing/testsuite/conf/test3.conf
===================================================================
--- trunk/testing/testsuite/conf/test3.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/conf/test3.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,76 @@
+#
+# test2.conf
+#
+# test all implemented commands
+#
+
+node node1 {
+ addr 10.25.91.10;
+ port 4000;
+}
+
+node node2 {
+ addr 10.25.91.11;
+ port 4000;
+}
+
+defaults {
+ timeout 30;
+ latency 0.05;
+}
+
+seq-commands {
+ cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi {resource}', rc 0;
+ cmd 'drbdadm up {resource}', rc 0;
+ expected 'cs', state 'Connected', timeout 10;
+ cmd 'drbdadm primary {resource}', on node1, rc 0;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+ sleep 2;
+
+ #Device Mapper
+ cmd 'dmsetup supend {dm_device}', rc 50;
+ expected 'st', state 'Secondary/Secondary', timeout 2;
+
+ cmd 'dmsetup resume {dm_device}', rc 10;
+ expected 'cs', state 'Connected', timeout 10;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+
+ #DRBD-Specific
+ cmd 'drbdadm secondary {resource}', on node1, rc 0;
+ expected 'st', on node1, state 'Secondary/Secondary', timeout 2;
+ sleep 2;
+
+ cmd 'drbdadm primary {resource}', on node1, rc 0;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+ sleep 2;
+
+ #turn of nw
+ cmd 'iptables -I OUTPUT -o $config{drbd_interface} -j DROP';
+ expected 'cs', state 'Disconnected', timeout 10;
+
+ #turn on nw
+ cmd 'iptables -I OUTPUT -o $config{drbd_interface} -j DROP';
+ expected 'cs', state 'Connected', timeout 10;
+
+ #stop drbd
+ cmd '/etc/init.d/drbd stop';
+ expected 'cs', state 'Disconnected', timeout 10;
+ expected 'st', on node1, state 'Secondary/Secondary', timeout 2;
+
+ #start drbd
+ cmd '/etc/init.d/drbd restart';
+ expected 'cs', state 'Connected', timeout 10;
+ expected 'st', on node1, state 'Secondary/Secondary', timeout 2;
+
+ #restart drbd
+ cmd '/etc/init.d/drbd restart';
+ expected 'cs', state 'Connected', timeout 10;
+ expected 'st', on node1, state 'Secondary/Secondary', timeout 2;
+
+ #mount
+ cmd 'mount /dev/{drbd_device} {drbd_mountpoint}';
+
+ #umount
+ cmd 'umount /dev/{device}';
+
+}
Added: trunk/testing/testsuite/conf/test4.conf
===================================================================
--- trunk/testing/testsuite/conf/test4.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/conf/test4.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,40 @@
+#
+# test3.conf
+#
+# turn off all disks and turn them on again after a while
+#
+
+node node1 {
+ addr 10.25.91.10;
+ port 4000;
+}
+
+node node2 {
+ addr 10.25.91.11;
+ port 4000;
+}
+
+defaults {
+ timeout 30;
+ latency 0.05;
+}
+
+seq-commands {
+
+ cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi {resource}', rc 0;
+ cmd 'drbdadm up {resource}', rc 0;
+ expected 'cs', state 'Connected', timeout 10;
+ cmd 'drbdadm primary {resource}', on node1, rc 0;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+ sleep 2;
+
+ cmd 'dmsetup supend {dm_device}', rc 50;
+ expected 'st', state 'Secondary/Secondary', timeout 2;
+
+ cmd 'dmsetup resume {dm_device}', rc 10;
+ expected 'cs', state 'Connected', timeout 10;
+ expected 'st', on node1, state 'Primary/Secondary', timeout 2;
+
+}
+
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/Changes
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/Changes 2006-06-20 14:01:05 UTC \
(rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/Changes 2006-06-20 15:15:48 UTC \
(rev 2239) @@ -0,0 +1,6 @@
+Revision history for Perl extension LinuxRealTime.
+
+0.01 Sun Aug 14 19:54:56 2005
+ - original version; created by h2xs 1.23 with options
+ -A -X -n LinuxRealTime
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.bs
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.c
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.c 2006-06-20 \
14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/LinuxRealTime.c 2006-06-20 \
15:15:48 UTC (rev 2239) @@ -0,0 +1,1178 @@
+#include <sched.h>
+
+void setRealTime(int prio)
+{
+ struct sched_param our_param;
+
+ our_param.sched_priority = prio;
+ sched_setscheduler(0, SCHED_FIFO, &our_param);
+}
+
+
+/* ----------------------------------------------------------------------------
+ * This file was automatically generated by SWIG (http://www.swig.org).
+ * Version 1.3.24
+ *
+ * This file is not intended to be easily readable and contains a number of
+ * coding conventions designed to improve portability and efficiency. Do not make
+ * changes to this file unless you know what you are doing--modify the SWIG
+ * interface file instead.
+ * ----------------------------------------------------------------------------- */
+
+
+#ifndef SWIG_TEMPLATE_DISAMBIGUATOR
+# if defined(__SUNPRO_CC)
+# define SWIG_TEMPLATE_DISAMBIGUATOR template
+# else
+# define SWIG_TEMPLATE_DISAMBIGUATOR
+# endif
+#endif
+
+/***********************************************************************
+ * swigrun.swg
+ *
+ * This file contains generic CAPI SWIG runtime support for pointer
+ * type checking.
+ *
+ ************************************************************************/
+
+/* This should only be incremented when either the layout of swig_type_info changes,
+ or for whatever reason, the runtime changes incompatibly */
+#define SWIG_RUNTIME_VERSION "1"
+
+/* define SWIG_TYPE_TABLE_NAME as "SWIG_TYPE_TABLE" */
+#ifdef SWIG_TYPE_TABLE
+#define SWIG_QUOTE_STRING(x) #x
+#define SWIG_EXPAND_AND_QUOTE_STRING(x) SWIG_QUOTE_STRING(x)
+#define SWIG_TYPE_TABLE_NAME SWIG_EXPAND_AND_QUOTE_STRING(SWIG_TYPE_TABLE)
+#else
+#define SWIG_TYPE_TABLE_NAME
+#endif
+
+#include <string.h>
+
+#ifndef SWIGINLINE
+#if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__))
+# define SWIGINLINE inline
+#else
+# define SWIGINLINE
+#endif
+#endif
+
+/*
+ You can use the SWIGRUNTIME and SWIGRUNTIMEINLINE macros for
+ creating a static or dynamic library from the swig runtime code.
+ In 99.9% of the cases, swig just needs to declare them as 'static'.
+
+ But only do this if is strictly necessary, ie, if you have problems
+ with your compiler or so.
+*/
+#ifndef SWIGRUNTIME
+#define SWIGRUNTIME static
+#endif
+#ifndef SWIGRUNTIMEINLINE
+#define SWIGRUNTIMEINLINE SWIGRUNTIME SWIGINLINE
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef void *(*swig_converter_func)(void *);
+typedef struct swig_type_info *(*swig_dycast_func)(void **);
+
+typedef struct swig_type_info {
+ const char *name;
+ swig_converter_func converter;
+ const char *str;
+ void *clientdata;
+ swig_dycast_func dcast;
+ struct swig_type_info *next;
+ struct swig_type_info *prev;
+} swig_type_info;
+
+/*
+ Compare two type names skipping the space characters, therefore
+ "char*" == "char *" and "Class<int>" == "Class<int >", etc.
+
+ Return 0 when the two name types are equivalent, as in
+ strncmp, but skipping ' '.
+*/
+SWIGRUNTIME int
+SWIG_TypeNameComp(const char *f1, const char *l1,
+ const char *f2, const char *l2) {
+ for (;(f1 != l1) && (f2 != l2); ++f1, ++f2) {
+ while ((*f1 == ' ') && (f1 != l1)) ++f1;
+ while ((*f2 == ' ') && (f2 != l2)) ++f2;
+ if (*f1 != *f2) return *f1 - *f2;
+ }
+ return (l1 - f1) - (l2 - f2);
+}
+
+/*
+ Check type equivalence in a name list like <name1>|<name2>|...
+*/
+SWIGRUNTIME int
+SWIG_TypeEquiv(const char *nb, const char *tb) {
+ int equiv = 0;
+ const char* te = tb + strlen(tb);
+ const char* ne = nb;
+ while (!equiv && *ne) {
+ for (nb = ne; *ne; ++ne) {
+ if (*ne == '|') break;
+ }
+ equiv = SWIG_TypeNameComp(nb, ne, tb, te) == 0;
+ if (*ne) ++ne;
+ }
+ return equiv;
+}
+
+/*
+ Register a type mapping with the type-checking
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeRegisterTL(swig_type_info **tl, swig_type_info *ti) {
+ swig_type_info *tc, *head, *ret, *next;
+ /* Check to see if this type has already been registered */
+ tc = *tl;
+ while (tc) {
+ /* check simple type equivalence */
+ int typeequiv = (strcmp(tc->name, ti->name) == 0);
+ /* check full type equivalence, resolving typedefs */
+ if (!typeequiv) {
+ /* only if tc is not a typedef (no '|' on it) */
+ if (tc->str && ti->str && !strstr(tc->str,"|")) {
+ typeequiv = SWIG_TypeEquiv(ti->str,tc->str);
+ }
+ }
+ if (typeequiv) {
+ /* Already exists in the table. Just add additional types to the list */
+ if (ti->clientdata) tc->clientdata = ti->clientdata;
+ head = tc;
+ next = tc->next;
+ goto l1;
+ }
+ tc = tc->prev;
+ }
+ head = ti;
+ next = 0;
+
+ /* Place in list */
+ ti->prev = *tl;
+ *tl = ti;
+
+ /* Build linked lists */
+ l1:
+ ret = head;
+ tc = ti + 1;
+ /* Patch up the rest of the links */
+ while (tc->name) {
+ head->next = tc;
+ tc->prev = head;
+ head = tc;
+ tc++;
+ }
+ if (next) next->prev = head;
+ head->next = next;
+
+ return ret;
+}
+
+/*
+ Check the typename
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeCheck(const char *c, swig_type_info *ty) {
+ swig_type_info *s;
+ if (!ty) return 0; /* Void pointer */
+ s = ty->next; /* First element always just a name */
+ do {
+ if (strcmp(s->name,c) == 0) {
+ if (s == ty->next) return s;
+ /* Move s to the top of the linked list */
+ s->prev->next = s->next;
+ if (s->next) {
+ s->next->prev = s->prev;
+ }
+ /* Insert s as second element in the list */
+ s->next = ty->next;
+ if (ty->next) ty->next->prev = s;
+ ty->next = s;
+ s->prev = ty;
+ return s;
+ }
+ s = s->next;
+ } while (s && (s != ty->next));
+ return 0;
+}
+
+/*
+ Cast a pointer up an inheritance hierarchy
+*/
+SWIGRUNTIMEINLINE void *
+SWIG_TypeCast(swig_type_info *ty, void *ptr) {
+ return ((!ty) || (!ty->converter)) ? ptr : (*ty->converter)(ptr);
+}
+
+/*
+ Dynamic pointer casting. Down an inheritance hierarchy
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeDynamicCast(swig_type_info *ty, void **ptr) {
+ swig_type_info *lastty = ty;
+ if (!ty || !ty->dcast) return ty;
+ while (ty && (ty->dcast)) {
+ ty = (*ty->dcast)(ptr);
+ if (ty) lastty = ty;
+ }
+ return lastty;
+}
+
+/*
+ Return the name associated with this type
+*/
+SWIGRUNTIMEINLINE const char *
+SWIG_TypeName(const swig_type_info *ty) {
+ return ty->name;
+}
+
+/*
+ Return the pretty name associated with this type,
+ that is an unmangled type name in a form presentable to the user.
+*/
+SWIGRUNTIME const char *
+SWIG_TypePrettyName(const swig_type_info *type) {
+ /* The "str" field contains the equivalent pretty names of the
+ type, separated by vertical-bar characters. We choose
+ to print the last name, as it is often (?) the most
+ specific. */
+ if (type->str != NULL) {
+ const char *last_name = type->str;
+ const char *s;
+ for (s = type->str; *s; s++)
+ if (*s == '|') last_name = s+1;
+ return last_name;
+ }
+ else
+ return type->name;
+}
+
+/*
+ Search for a swig_type_info structure
+*/
+SWIGRUNTIME swig_type_info *
+SWIG_TypeQueryTL(swig_type_info *tl, const char *name) {
+ swig_type_info *ty = tl;
+ while (ty) {
+ if (ty->str && (SWIG_TypeEquiv(ty->str,name))) return ty;
+ if (ty->name && (strcmp(name,ty->name) == 0)) return ty;
+ ty = ty->prev;
+ }
+ return 0;
+}
+
+/*
+ Set the clientdata field for a type
+*/
+SWIGRUNTIME void
+SWIG_TypeClientDataTL(swig_type_info *tl, swig_type_info *ti, void *clientdata) {
+ swig_type_info *tc, *equiv;
+ if (ti->clientdata) return;
+ /* if (ti->clientdata == clientdata) return; */
+ ti->clientdata = clientdata;
+ equiv = ti->next;
+ while (equiv) {
+ if (!equiv->converter) {
+ tc = tl;
+ while (tc) {
+ if ((strcmp(tc->name, equiv->name) == 0))
+ SWIG_TypeClientDataTL(tl,tc,clientdata);
+ tc = tc->prev;
+ }
+ }
+ equiv = equiv->next;
+ }
+}
+
+/*
+ Pack binary data into a string
+*/
+SWIGRUNTIME char *
+SWIG_PackData(char *c, void *ptr, size_t sz) {
+ static char hex[17] = "0123456789abcdef";
+ unsigned char *u = (unsigned char *) ptr;
+ const unsigned char *eu = u + sz;
+ register unsigned char uu;
+ for (; u != eu; ++u) {
+ uu = *u;
+ *(c++) = hex[(uu & 0xf0) >> 4];
+ *(c++) = hex[uu & 0xf];
+ }
+ return c;
+}
+
+/*
+ Unpack binary data from a string
+*/
+SWIGRUNTIME const char *
+SWIG_UnpackData(const char *c, void *ptr, size_t sz) {
+ register unsigned char *u = (unsigned char *) ptr;
+ register const unsigned char *eu = u + sz;
+ for (; u != eu; ++u) {
+ register int d = *(c++);
+ register unsigned char uu = 0;
+ if ((d >= '0') && (d <= '9'))
+ uu = ((d - '0') << 4);
+ else if ((d >= 'a') && (d <= 'f'))
+ uu = ((d - ('a'-10)) << 4);
+ else
+ return (char *) 0;
+ d = *(c++);
+ if ((d >= '0') && (d <= '9'))
+ uu |= (d - '0');
+ else if ((d >= 'a') && (d <= 'f'))
+ uu |= (d - ('a'-10));
+ else
+ return (char *) 0;
+ *u = uu;
+ }
+ return c;
+}
+
+/*
+ This function will propagate the clientdata field of type to any new
+ swig_type_info structures that have been added into the list of
+ equivalent types. It is like calling SWIG_TypeClientData(type,
+ clientdata) a second time.
+*/
+SWIGRUNTIME void
+SWIG_PropagateClientDataTL(swig_type_info *tl, swig_type_info *type) {
+ swig_type_info *equiv = type->next;
+ swig_type_info *tc;
+ if (!type->clientdata) return;
+ while (equiv) {
+ if (!equiv->converter) {
+ tc = tl;
+ while (tc) {
+ if ((strcmp(tc->name, equiv->name) == 0) && !tc->clientdata)
+ SWIG_TypeClientDataTL(tl,tc, type->clientdata);
+ tc = tc->prev;
+ }
+ }
+ equiv = equiv->next;
+ }
+}
+
+/*
+ Pack 'void *' into a string buffer.
+*/
+SWIGRUNTIME char *
+SWIG_PackVoidPtr(char *buff, void *ptr, const char *name, size_t bsz) {
+ char *r = buff;
+ if ((2*sizeof(void *) + 2) > bsz) return 0;
+ *(r++) = '_';
+ r = SWIG_PackData(r,&ptr,sizeof(void *));
+ if (strlen(name) + 1 > (bsz - (r - buff))) return 0;
+ strcpy(r,name);
+ return buff;
+}
+
+SWIGRUNTIME const char *
+SWIG_UnpackVoidPtr(const char *c, void **ptr, const char *name) {
+ if (*c != '_') {
+ if (strcmp(c,"NULL") == 0) {
+ *ptr = (void *) 0;
+ return name;
+ } else {
+ return 0;
+ }
+ }
+ return SWIG_UnpackData(++c,ptr,sizeof(void *));
+}
+
+SWIGRUNTIME char *
+SWIG_PackDataName(char *buff, void *ptr, size_t sz, const char *name, size_t bsz) {
+ char *r = buff;
+ size_t lname = (name ? strlen(name) : 0);
+ if ((2*sz + 2 + lname) > bsz) return 0;
+ *(r++) = '_';
+ r = SWIG_PackData(r,ptr,sz);
+ if (lname) {
+ strncpy(r,name,lname+1);
+ } else {
+ *r = 0;
+ }
+ return buff;
+}
+
+SWIGRUNTIME const char *
+SWIG_UnpackDataName(const char *c, void *ptr, size_t sz, const char *name) {
+ if (*c != '_') {
+ if (strcmp(c,"NULL") == 0) {
+ memset(ptr,0,sz);
+ return name;
+ } else {
+ return 0;
+ }
+ }
+ return SWIG_UnpackData(++c,ptr,sz);
+}
+
+#ifdef __cplusplus
+}
+#endif
+
+/***********************************************************************
+ * common.swg
+ *
+ * This file contains generic SWIG runtime support for pointer
+ * type checking as well as a few commonly used macros to control
+ * external linkage.
+ *
+ * Author : David Beazley (beazley@cs.uchicago.edu)
+ *
+ * Copyright (c) 1999-2000, The University of Chicago
+ *
+ * This file may be freely redistributed without license or fee provided
+ * this copyright message remains intact.
+ ************************************************************************/
+
+
+#if defined(_WIN32) || defined(__WIN32__) || defined(__CYGWIN__)
+# if !defined(STATIC_LINKED)
+# define SWIGEXPORT(a) __declspec(dllexport) a
+# else
+# define SWIGEXPORT(a) a
+# endif
+#else
+# define SWIGEXPORT(a) a
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+
+/*************************************************************************/
+
+
+/* The static type info list */
+
+static swig_type_info *swig_type_list = 0;
+static swig_type_info **swig_type_list_handle = &swig_type_list;
+
+
+/* Register a type mapping with the type-checking */
+static swig_type_info *
+SWIG_TypeRegister(swig_type_info *ti) {
+ return SWIG_TypeRegisterTL(swig_type_list_handle, ti);
+}
+
+/* Search for a swig_type_info structure */
+static swig_type_info *
+SWIG_TypeQuery(const char *name) {
+ return SWIG_TypeQueryTL(*swig_type_list_handle, name);
+}
+
+/* Set the clientdata field for a type */
+static void
+SWIG_TypeClientData(swig_type_info *ti, void *clientdata) {
+ SWIG_TypeClientDataTL(*swig_type_list_handle, ti, clientdata);
+}
+
+/* This function will propagate the clientdata field of type to
+* any new swig_type_info structures that have been added into the list
+* of equivalent types. It is like calling
+* SWIG_TypeClientData(type, clientdata) a second time.
+*/
+static void
+SWIG_PropagateClientData(swig_type_info *type) {
+ SWIG_PropagateClientDataTL(*swig_type_list_handle, type);
+}
+
+#ifdef __cplusplus
+}
+#endif
+
+/* ---------------------------------------------------------------------- -*- c -*-
+ * perl5.swg
+ *
+ * Perl5 runtime library
+ * $Header: /cvsroot/swig/SWIG/Lib/perl5/perlrun.swg,v 1.20 2004/11/29 23:13:57 \
wuzzeb Exp $ + * ----------------------------------------------------------------------------- \
*/ +
+#define SWIGPERL
+#define SWIGPERL5
+#ifdef __cplusplus
+/* Needed on some windows machines---since MS plays funny games with the header \
files under C++ */ +#include <math.h>
+#include <stdlib.h>
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* Get rid of free and malloc defined by perl */
+#undef free
+#undef malloc
+
+#ifndef pTHX_
+#define pTHX_
+#endif
+
+#include <string.h>
+#ifdef __cplusplus
+}
+#endif
+
+/* Macro to call an XS function */
+
+#ifdef PERL_OBJECT
+# define SWIG_CALLXS(_name) _name(cv,pPerl)
+#else
+# ifndef MULTIPLICITY
+# define SWIG_CALLXS(_name) _name(cv)
+# else
+# define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv)
+# endif
+#endif
+
+/* Contract support */
+
+#define SWIG_contract_assert(expr,msg) if (!(expr)) { SWIG_croak(msg); } else
+
+/* Note: SwigMagicFuncHack is a typedef used to get the C++ compiler to just shut up \
already */ +
+#ifdef PERL_OBJECT
+#define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this;
+typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (CPerlObj::*SwigMagicFuncHack)(SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
+#define SWIGCLASS_STATIC
+#else
+#define MAGIC_PPERL
+#define SWIGCLASS_STATIC static
+#ifndef MULTIPLICITY
+#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
+typedef int (*SwigMagicFunc)(SV *, MAGIC *);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (*SwigMagicFuncHack)(SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+
+#else
+#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
+typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef int (*SwigMagicFuncHack)(struct interpreter *, SV *, MAGIC *);
+#ifdef __cplusplus
+}
+#endif
+
+#endif
+#endif
+
+#if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE)
+#define PerlIO_exportFILE(fh,fl) (FILE*)(fh)
+#endif
+
+/* Modifications for newer Perl 5.005 releases */
+
+#if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || \
((PERL_VERSION == 5) && (PERL_SUBVERSION < 50)))) +# ifndef PL_sv_yes
+# define PL_sv_yes sv_yes
+# endif
+# ifndef PL_sv_undef
+# define PL_sv_undef sv_undef
+# endif
+# ifndef PL_na
+# define PL_na na
+# endif
+#endif
+
+#include <stdlib.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define SWIG_OWNER 1
+#define SWIG_SHADOW 2
+
+/* Common SWIG API */
+
+#ifdef PERL_OBJECT
+# define SWIG_ConvertPtr(obj, pp, type, flags) \
+ SWIG_Perl_ConvertPtr(pPerl, obj, pp, type, flags)
+# define SWIG_NewPointerObj(p, type, flags) \
+ SWIG_Perl_NewPointerObj(pPerl, p, type, flags)
+# define SWIG_MakePackedObj(sv, p, s, type) \
+ SWIG_Perl_MakePackedObj(pPerl, sv, p, s, type)
+# define SWIG_ConvertPacked(obj, p, s, type, flags) \
+ SWIG_Perl_ConvertPacked(pPerl, obj, p, s, type, flags)
+
+#else
+# define SWIG_ConvertPtr(obj, pp, type, flags) \
+ SWIG_Perl_ConvertPtr(obj, pp, type, flags)
+# define SWIG_NewPointerObj(p, type, flags) \
+ SWIG_Perl_NewPointerObj(p, type, flags)
+# define SWIG_MakePackedObj(sv, p, s, type) \
+ SWIG_Perl_MakePackedObj(sv, p, s, type )
+# define SWIG_ConvertPacked(obj, p, s, type, flags) \
+ SWIG_Perl_ConvertPacked(obj, p, s, type, flags)
+#endif
+
+/* Perl-specific API */
+#ifdef PERL_OBJECT
+# define SWIG_MakePtr(sv, ptr, type, flags) \
+ SWIG_Perl_MakePtr(pPerl, sv, ptr, type, flags)
+# define SWIG_SetError(str) \
+ SWIG_Perl_SetError(pPerl, str)
+#else
+# define SWIG_MakePtr(sv, ptr, type, flags) \
+ SWIG_Perl_MakePtr(sv, ptr, type, flags)
+# define SWIG_SetError(str) \
+ SWIG_Perl_SetError(str)
+# define SWIG_SetErrorSV(str) \
+ SWIG_Perl_SetErrorSV(str)
+#endif
+
+#define SWIG_SetErrorf SWIG_Perl_SetErrorf
+
+
+#ifdef PERL_OBJECT
+# define SWIG_MAYBE_PERL_OBJECT CPerlObj *pPerl,
+#else
+# define SWIG_MAYBE_PERL_OBJECT
+#endif
+
+static swig_type_info **
+SWIG_Perl_GetTypeListHandle() {
+ static void *type_pointer = (void *)0;
+ SV *pointer;
+
+ /* first check if pointer already created */
+ if (!type_pointer) {
+ pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION \
SWIG_TYPE_TABLE_NAME, FALSE); + if (pointer && SvOK(pointer)) {
+ type_pointer = INT2PTR(swig_type_info **, SvIV(pointer));
+ }
+ }
+
+ return (swig_type_info **) type_pointer;
+}
+
+/*
+ Search for a swig_type_info structure
+ */
+SWIGRUNTIMEINLINE swig_type_info *
+SWIG_Perl_GetTypeList() {
+ swig_type_info **tlh = SWIG_Perl_GetTypeListHandle();
+ return tlh ? *tlh : (swig_type_info*)0;
+}
+
+#define SWIG_Runtime_GetTypeList SWIG_Perl_GetTypeList
+
+static swig_type_info *
+SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT SV *rv, swig_type_info *ty) {
+ swig_type_info *s;
+ if (!ty) return 0; /* Void pointer */
+ s = ty->next; /* First element always just a name */
+ do {
+ if (sv_derived_from(rv, (char *) s->name)) {
+ if (s == ty->next) return s;
+ /* Move s to the top of the linked list */
+ s->prev->next = s->next;
+ if (s->next) {
+ s->next->prev = s->prev;
+ }
+ /* Insert s as second element in the list */
+ s->next = ty->next;
+ if (ty->next) ty->next->prev = s;
+ ty->next = s;
+ s->prev = ty;
+ return s;
+ }
+ s = s->next;
+ } while (s && (s != ty->next));
+ return 0;
+}
+
+/* Function for getting a pointer value */
+
+static int
+SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, \
int flags) { + swig_type_info *tc;
+ void *voidptr = (void *)0;
+
+ /* If magical, apply more magic */
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
+
+ /* Check to see if this is an object */
+ if (sv_isobject(sv)) {
+ SV *tsv = (SV*) SvRV(sv);
+ IV tmp = 0;
+ if ((SvTYPE(tsv) == SVt_PVHV)) {
+ MAGIC *mg;
+ if (SvMAGICAL(tsv)) {
+ mg = mg_find(tsv,'P');
+ if (mg) {
+ sv = mg->mg_obj;
+ if (sv_isobject(sv)) {
+ tmp = SvIV((SV*)SvRV(sv));
+ }
+ }
+ } else {
+ return -1;
+ }
+ } else {
+ tmp = SvIV((SV*)SvRV(sv));
+ }
+ voidptr = (void *)tmp;
+ if (!_t) {
+ *(ptr) = voidptr;
+ return 0;
+ }
+ } else if (! SvOK(sv)) { /* Check for undef */
+ *(ptr) = (void *) 0;
+ return 0;
+ } else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */
+ *(ptr) = (void *) 0;
+ if (!SvROK(sv))
+ return 0;
+ else
+ return -1;
+ } else { /* Don't know what it is */
+ *(ptr) = (void *) 0;
+ return -1;
+ }
+ if (_t) {
+ /* Now see if the types match */
+ char *_c = HvNAME(SvSTASH(SvRV(sv)));
+ tc = SWIG_TypeCheck(_c,_t);
+ if (!tc) {
+ *ptr = voidptr;
+ return -1;
+ }
+ *ptr = SWIG_TypeCast(tc,voidptr);
+ return 0;
+ }
+ *ptr = voidptr;
+ return 0;
+}
+
+static void
+SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int \
flags) { + if (ptr && (flags & SWIG_SHADOW)) {
+ SV *self;
+ SV *obj=newSV(0);
+ HV *hash=newHV();
+ HV *stash;
+ sv_setref_pv(obj, (char *) t->name, ptr);
+ stash=SvSTASH(SvRV(obj));
+ if (flags & SWIG_OWNER) {
+ HV *hv;
+ GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
+ if (!isGV(gv))
+ gv_init(gv, stash, "OWNER", 5, FALSE);
+ hv=GvHVn(gv);
+ hv_store_ent(hv, obj, newSViv(1), 0);
+ }
+ sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0);
+ SvREFCNT_dec(obj);
+ self=newRV_noinc((SV *)hash);
+ sv_setsv(sv, self);
+ SvREFCNT_dec((SV *)self);
+ sv_bless(sv, stash);
+ }
+ else {
+ sv_setref_pv(sv, (char *) t->name, ptr);
+ }
+}
+
+static SWIGINLINE SV *
+SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int \
flags) { + SV *result = sv_newmortal();
+ SWIG_MakePtr(result, ptr, t, flags);
+ return result;
+}
+
+static void
+ SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, \
swig_type_info *type) { + char result[1024];
+ char *r = result;
+ if ((2*sz + 1 + strlen(type->name)) > 1000) return;
+ *(r++) = '_';
+ r = SWIG_PackData(r,ptr,sz);
+ strcpy(r,type->name);
+ sv_setpv(sv, result);
+}
+
+/* Convert a packed value value */
+static int
+SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, \
swig_type_info *ty, int flags) { + swig_type_info *tc;
+ const char *c = 0;
+
+ if ((!obj) || (!SvOK(obj))) return -1;
+ c = SvPV(obj, PL_na);
+ /* Pointer values must start with leading underscore */
+ if (*c != '_') return -1;
+ c++;
+ c = SWIG_UnpackData(c,ptr,sz);
+ if (ty) {
+ tc = SWIG_TypeCheck(c,ty);
+ if (!tc) return -1;
+ }
+ return 0;
+}
+
+static SWIGINLINE void
+SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT const char *error) {
+ if (error) sv_setpv(perl_get_sv("@", TRUE), error);
+}
+
+static SWIGINLINE void
+SWIG_Perl_SetErrorSV(SWIG_MAYBE_PERL_OBJECT SV *error) {
+ if (error) sv_setsv(perl_get_sv("@", TRUE), error);
+}
+
+static void
+SWIG_Perl_SetErrorf(const char *fmt, ...) {
+ va_list args;
+ va_start(args, fmt);
+ sv_vsetpvfn(perl_get_sv("@", TRUE), fmt, strlen(fmt), &args, Null(SV**), 0, \
Null(bool*)); + va_end(args);
+}
+
+/* Macros for low-level exception handling */
+#define SWIG_fail goto fail
+#define SWIG_croak(x) { SWIG_SetError(x); goto fail; }
+#define SWIG_croakSV(x) { SWIG_SetErrorSV(x); goto fail; }
+/* most preprocessors do not support vararg macros :-( */
+/* #define SWIG_croakf(x...) { SWIG_SetErrorf(x); goto fail; } */
+
+
+typedef XS(SwigPerlWrapper);
+typedef SwigPerlWrapper *SwigPerlWrapperPtr;
+
+/* Structure for command table */
+typedef struct {
+ const char *name;
+ SwigPerlWrapperPtr wrapper;
+} swig_command_info;
+
+/* Information for constant table */
+
+#define SWIG_INT 1
+#define SWIG_FLOAT 2
+#define SWIG_STRING 3
+#define SWIG_POINTER 4
+#define SWIG_BINARY 5
+
+/* Constant information structure */
+typedef struct swig_constant_info {
+ int type;
+ const char *name;
+ long lvalue;
+ double dvalue;
+ void *pvalue;
+ swig_type_info **ptype;
+} swig_constant_info;
+
+#ifdef __cplusplus
+}
+#endif
+
+/* Structure for variable table */
+typedef struct {
+ const char *name;
+ SwigMagicFunc set;
+ SwigMagicFunc get;
+ swig_type_info **type;
+} swig_variable_info;
+
+/* Magic variable code */
+#ifndef PERL_OBJECT
+#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c)
+ #ifndef MULTIPLICITY
+ static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), \
int (*get)(SV *,MAGIC *)) { + #else
+ static void _swig_create_magic(SV *sv, char *name, int (*set)(struct \
interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) { + \
#endif +#else
+# define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
+static void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int \
(CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) { +#endif
+ MAGIC *mg;
+ sv_magic(sv,sv,'U',(char *) name,strlen(name));
+ mg = mg_find(sv,'U');
+ mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
+ mg->mg_virtual->svt_get = (SwigMagicFuncHack) get;
+ mg->mg_virtual->svt_set = (SwigMagicFuncHack) set;
+ mg->mg_virtual->svt_len = 0;
+ mg->mg_virtual->svt_clear = 0;
+ mg->mg_virtual->svt_free = 0;
+}
+
+
+
+
+
+
+#ifdef do_open
+ #undef do_open
+#endif
+#ifdef do_close
+ #undef do_close
+#endif
+#ifdef scalar
+ #undef scalar
+#endif
+#ifdef list
+ #undef list
+#endif
+#ifdef apply
+ #undef apply
+#endif
+#ifdef convert
+ #undef convert
+#endif
+#ifdef Error
+ #undef Error
+#endif
+#ifdef form
+ #undef form
+#endif
+#ifdef vform
+ #undef vform
+#endif
+#ifdef LABEL
+ #undef LABEL
+#endif
+#ifdef METHOD
+ #undef METHOD
+#endif
+#ifdef Move
+ #undef Move
+#endif
+#ifdef yylex
+ #undef yylex
+#endif
+#ifdef yyparse
+ #undef yyparse
+#endif
+#ifdef yyerror
+ #undef yyerror
+#endif
+#ifdef invert
+ #undef invert
+#endif
+#ifdef ref
+ #undef ref
+#endif
+#ifdef ENTER
+ #undef ENTER
+#endif
+
+
+/* -------- TYPES TABLE (BEGIN) -------- */
+
+static swig_type_info *swig_types[1];
+
+/* -------- TYPES TABLE (END) -------- */
+
+#define SWIG_init boot_LinuxRealTime
+
+#define SWIG_name "LinuxRealTimec::boot_LinuxRealTime"
+#define SWIG_prefix "LinuxRealTimec::"
+
+#ifdef __cplusplus
+extern "C"
+#endif
+#ifndef PERL_OBJECT
+#ifndef MULTIPLICITY
+SWIGEXPORT(void) SWIG_init (CV* cv);
+#else
+SWIGEXPORT(void) SWIG_init (pTHXo_ CV* cv);
+#endif
+#else
+SWIGEXPORT(void) SWIG_init (CV *cv, CPerlObj *);
+#endif
+
+
+ void setRealTime(int prio);
+
+#ifdef PERL_OBJECT
+#define MAGIC_CLASS _wrap_LinuxRealTime_var::
+class _wrap_LinuxRealTime_var : public CPerlObj {
+public:
+#else
+#define MAGIC_CLASS
+#endif
+SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *sv, MAGIC *mg) {
+ MAGIC_PPERL
+ sv = sv; mg = mg;
+ croak("Value is read-only.");
+ return 0;
+}
+
+
+#ifdef PERL_OBJECT
+};
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+XS(_wrap_setRealTime) {
+ {
+ int arg1 ;
+ int argvi = 0;
+ dXSARGS;
+
+ if ((items < 1) || (items > 1)) {
+ SWIG_croak("Usage: setRealTime(prio);");
+ }
+ arg1 = (int) SvIV(ST(0));
+ setRealTime(arg1);
+
+
+ XSRETURN(argvi);
+ fail:
+ ;
+ }
+ croak(Nullch);
+}
+
+
+
+/* -------- TYPE CONVERSION AND EQUIVALENCE RULES (BEGIN) -------- */
+
+
+static swig_type_info *swig_types_initial[] = {
+0
+};
+
+
+/* -------- TYPE CONVERSION AND EQUIVALENCE RULES (END) -------- */
+
+static swig_constant_info swig_constants[] = {
+{0,0,0,0,0,0}
+};
+#ifdef __cplusplus
+}
+#endif
+static swig_variable_info swig_variables[] = {
+{0,0,0,0}
+};
+static swig_command_info swig_commands[] = {
+{"LinuxRealTimec::setRealTime", _wrap_setRealTime},
+{0,0}
+};
+
+
+static void SWIG_Perl_SetTypeListHandle(swig_type_info **handle) {
+ SV *pointer;
+
+ /* create a new pointer */
+ pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION \
SWIG_TYPE_TABLE_NAME, TRUE); + sv_setiv(pointer, PTR2IV(swig_type_list_handle));
+}
+
+static swig_type_info **
+SWIG_Perl_LookupTypePointer(swig_type_info **type_list_handle) {
+ swig_type_info **type_pointer;
+
+ /* first check if module already created */
+ type_pointer = SWIG_Perl_GetTypeListHandle();
+ if (type_pointer) {
+ return type_pointer;
+ } else {
+ /* create a new module and variable */
+ SWIG_Perl_SetTypeListHandle(type_list_handle);
+ return type_list_handle;
+ }
+}
+
+
+#ifdef __cplusplus
+extern "C"
+#endif
+
+XS(SWIG_init) {
+ dXSARGS;
+ int i;
+ static int _init = 0;
+ if (!_init) {
+ swig_type_list_handle = SWIG_Perl_LookupTypePointer(swig_type_list_handle);
+ for (i = 0; swig_types_initial[i]; i++) {
+ swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
+ }
+ _init = 1;
+ }
+
+ /* Install commands */
+ for (i = 0; swig_commands[i].name; i++) {
+ newXS((char*) swig_commands[i].name,swig_commands[i].wrapper, \
(char*)__FILE__); + }
+
+ /* Install variables */
+ for (i = 0; swig_variables[i].name; i++) {
+ SV *sv;
+ sv = perl_get_sv((char*) swig_variables[i].name, TRUE | 0x2);
+ if (swig_variables[i].type) {
+ SWIG_MakePtr(sv,(void *)1, *swig_variables[i].type,0);
+ } else {
+ sv_setiv(sv,(IV) 0);
+ }
+ swig_create_magic(sv, (char *) swig_variables[i].name, \
swig_variables[i].set, swig_variables[i].get); + }
+
+ /* Install constant */
+ for (i = 0; swig_constants[i].type; i++) {
+ SV *sv;
+ sv = perl_get_sv((char*)swig_constants[i].name, TRUE | 0x2);
+ switch(swig_constants[i].type) {
+ case SWIG_INT:
+ sv_setiv(sv, (IV) swig_constants[i].lvalue);
+ break;
+ case SWIG_FLOAT:
+ sv_setnv(sv, (double) swig_constants[i].dvalue);
+ break;
+ case SWIG_STRING:
+ sv_setpv(sv, (char *) swig_constants[i].pvalue);
+ break;
+ case SWIG_POINTER:
+ SWIG_MakePtr(sv, swig_constants[i].pvalue, \
*(swig_constants[i].ptype),0); + break;
+ case SWIG_BINARY:
+ SWIG_MakePackedObj(sv, swig_constants[i].pvalue, \
swig_constants[i].lvalue, *(swig_constants[i].ptype)); + break;
+ default:
+ break;
+ }
+ SvREADONLY_on(sv);
+ }
+
+ ST(0) = &PL_sv_yes;
+ XSRETURN(1);
+}
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/MANIFEST
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/MANIFEST 2006-06-20 14:01:05 UTC \
(rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/MANIFEST 2006-06-20 15:15:48 UTC \
(rev 2239) @@ -0,0 +1,8 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/LinuxRealTime.t
+lib/LinuxRealTime.pm
+META.yml Module meta-data (added by MakeMaker)
+LinuxRealTime.c
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/META.yml
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/META.yml 2006-06-20 14:01:05 UTC \
(rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/META.yml 2006-06-20 15:15:48 UTC \
(rev 2239) @@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: LinuxRealTime
+version: 0.01
+version_from: lib/LinuxRealTime.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile 2006-06-20 14:01:05 UTC \
(rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile 2006-06-20 15:15:48 UTC \
(rev 2239) @@ -0,0 +1,930 @@
+# This Makefile is for the LinuxRealTime extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 6.30 (Revision: Revision: 4535 ) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+# ANY CHANGES MADE HERE WILL BE LOST!
+#
+# MakeMaker ARGV: ()
+#
+# MakeMaker Parameters:
+
+# ABSTRACT_FROM => q[lib/LinuxRealTime.pm]
+# AUTHOR => q[Daniel Zinn <q@>]
+# NAME => q[LinuxRealTime]
+# PREREQ_PM => { }
+# VERSION_FROM => q[lib/LinuxRealTime.pm]
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via \
/usr/lib/perl5/5.8.8/i386-linux-thread-multi/Config.pm) +
+# They may have been overridden via Makefile.PL or on the command line
+AR = ar
+CC = gcc
+CCCDLFLAGS = -fPIC
+CCDLFLAGS = -Wl,-E -Wl,-rpath,/usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE
+DLEXT = so
+DLSRC = dl_dlopen.xs
+LD = gcc
+LDDLFLAGS = -shared -L/usr/local/lib
+LDFLAGS = -L/usr/local/lib
+LIBC = /lib/libc-2.3.90.so
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 2.6.9-22.18.bz155725.elsmp
+RANLIB = :
+SITELIBEXP = /usr/lib/perl5/site_perl/5.8.8
+SITEARCHEXP = /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
+SO = so
+EXE_EXT =
+FULL_AR = /usr/bin/ar
+VENDORARCHEXP = /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
+VENDORLIBEXP = /usr/lib/perl5/vendor_perl/5.8.8
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+DIRFILESEP = /
+DFSEP = $(DIRFILESEP)
+NAME = LinuxRealTime
+NAME_SYM = LinuxRealTime
+VERSION = 0.01
+VERSION_MACRO = VERSION
+VERSION_SYM = 0_01
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION = 0.01
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+INST_BIN = blib/bin
+INST_LIB = blib/lib
+INST_MAN1DIR = blib/man1
+INST_MAN3DIR = blib/man3
+MAN1EXT = 1
+MAN3EXT = 3pm
+INSTALLDIRS = site
+DESTDIR =
+PREFIX = $(SITEPREFIX)
+PERLPREFIX = /usr
+SITEPREFIX = /usr
+VENDORPREFIX = /usr
+INSTALLPRIVLIB = /usr/lib/perl5/5.8.8
+DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
+INSTALLSITELIB = /usr/lib/perl5/site_perl/5.8.8
+DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
+INSTALLVENDORLIB = /usr/lib/perl5/vendor_perl/5.8.8
+DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
+INSTALLARCHLIB = /usr/lib/perl5/5.8.8/i386-linux-thread-multi
+DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
+INSTALLSITEARCH = /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
+DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
+INSTALLVENDORARCH = /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
+DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
+INSTALLBIN = /usr/bin
+DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
+INSTALLSITEBIN = /usr/bin
+DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
+INSTALLVENDORBIN = /usr/bin
+DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
+INSTALLSCRIPT = /usr/bin
+DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
+INSTALLMAN1DIR = /usr/share/man/man1
+DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
+INSTALLSITEMAN1DIR = /usr/share/man/man1
+DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
+INSTALLVENDORMAN1DIR = /usr/share/man/man1
+DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
+INSTALLMAN3DIR = /usr/share/man/man3
+DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
+INSTALLSITEMAN3DIR = /usr/share/man/man3
+DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
+INSTALLVENDORMAN3DIR = /usr/share/man/man3
+DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
+PERL_LIB = /usr/lib/perl5/5.8.8
+PERL_ARCHLIB = /usr/lib/perl5/5.8.8/i386-linux-thread-multi
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKEFILE_OLD = Makefile.old
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = /usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE
+PERL = /usr/bin/perl
+FULLPERL = /usr/bin/perl
+ABSPERL = $(PERL)
+PERLRUN = $(PERL)
+FULLPERLRUN = $(FULLPERL)
+ABSPERLRUN = $(ABSPERL)
+PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+PERL_CORE = 0
+PERM_RW = 644
+PERM_RWX = 755
+
+MAKEMAKER = /usr/lib/perl5/5.8.8/ExtUtils/MakeMaker.pm
+MM_VERSION = 6.30
+MM_REVISION = Revision: 4535
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
+FULLEXT = LinuxRealTime
+BASEEXT = LinuxRealTime
+PARENT_NAME =
+DLBASE = $(BASEEXT)
+VERSION_FROM = lib/LinuxRealTime.pm
+OBJECT = $(BASEEXT)$(OBJ_EXT)
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+BOOTDEP =
+
+# Handy lists of source code files:
+XS_FILES =
+C_FILES = LinuxRealTime.c
+O_FILES = LinuxRealTime.o
+H_FILES =
+MAN1PODS =
+MAN3PODS = lib/LinuxRealTime.pm
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
+
+# Where to build things
+INST_LIBDIR = $(INST_LIB)
+INST_ARCHLIBDIR = $(INST_ARCHLIB)
+
+INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
+INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
+
+# Extra linker info
+EXPORT_LIST =
+PERL_ARCHIVE =
+PERL_ARCHIVE_AFTER =
+
+
+TO_INST_PM = lib/LinuxRealTime.pm
+
+PM_TO_BLIB = lib/LinuxRealTime.pm \
+ blib/lib/LinuxRealTime.pm
+
+
+# --- MakeMaker platform_constants section:
+MM_Unix_VERSION = 1.50
+PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree \
-Drealloc=Perl_realloc -Dcalloc=Perl_calloc +
+
+# --- MakeMaker tool_autosplit section:
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], \
0, 1, 1)' +
+
+
+# --- MakeMaker tool_xsubpp section:
+
+XSUBPPDIR = /usr/lib/perl5/5.8.8/ExtUtils
+XSUBPP = $(XSUBPPDIR)$(DFSEP)xsubpp
+XSUBPPRUN = $(PERLRUN) $(XSUBPP)
+XSPROTOARG =
+XSUBPPDEPS = /usr/lib/perl5/5.8.8/ExtUtils/typemap $(XSUBPP)
+XSUBPPARGS = -typemap /usr/lib/perl5/5.8.8/ExtUtils/typemap
+XSUBPP_EXTRA_ARGS =
+
+
+# --- MakeMaker tools_other section:
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+MV = mv
+NOOP = $(SHELL) -c true
+NOECHO = @
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
+EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
+ECHO = echo
+ECHO_N = echo -n
+UNINST = 0
+VERBINST = 0
+MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, \
'\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');' +DOC_INSTALL = $(ABSPERLRUN) \
"-MExtUtils::Command::MM" -e perllocal_install +UNINSTALL = $(ABSPERLRUN) \
"-MExtUtils::Command::MM" -e uninstall +WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) \
"-MExtUtils::Command::MM" -e warn_if_old_packlist +MACROSTART =
+MACROEND =
+USEMAKEFILE = -f
+FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"
+
+
+# --- MakeMaker makemakerdflt section:
+makemakerdflt: all
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dist section:
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = $(NOECHO) $(NOOP)
+POSTOP = $(NOECHO) $(NOOP)
+TO_UNIX = $(NOECHO) $(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+DISTNAME = LinuxRealTime
+DISTVNAME = LinuxRealTime-0.01
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+CCFLAGS = -D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe \
-Wdeclaration-after-statement -I/usr/local/include -D_LARGEFILE_SOURCE \
-D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm +OPTIMIZE = -O2 -g -pipe -Wall \
-Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector --param=ssp-buffer-size=4 -m32 \
-march=i386 -mtune=generic -fasynchronous-unwind-tables +PERLTYPE =
+MPOLLUTE =
+
+
+# --- MakeMaker const_loadlibs section:
+
+# LinuxRealTime might depend on some other libraries:
+# See ExtUtils::Liblist for details
+#
+
+
+# --- MakeMaker const_cccmd section:
+CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \
+ $(CCFLAGS) $(OPTIMIZE) \
+ $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
+ $(XS_DEFINE_VERSION)
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
+ LINKTYPE="$(LINKTYPE)"\
+ OPTIMIZE="$(OPTIMIZE)"\
+ PREFIX="$(PREFIX)"
+
+
+# --- MakeMaker special_targets section:
+.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
+
+.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean \
disttest distdir +
+
+
+# --- MakeMaker c_o section:
+
+.c.i:
+ gcc -E -c $(PASTHRU_INC) $(INC) \
+ $(CCFLAGS) $(OPTIMIZE) \
+ $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
+ $(XS_DEFINE_VERSION) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c \
> $*.i +
+.c.s:
+ $(CCCMD) -S $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
+
+.c$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
+
+.C$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.C
+
+.cpp$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cpp
+
+.cxx$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cxx
+
+.cc$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cc
+
+
+# --- MakeMaker xs_c section:
+
+.xs.c:
+ $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && \
$(MV) $*.xsc $*.c +
+
+# --- MakeMaker xs_o section:
+
+.xs$(OBJ_EXT):
+ $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
+ $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
+
+
+# --- MakeMaker top_targets section:
+all :: pure_all manifypods
+ $(NOECHO) $(NOOP)
+
+
+pure_all :: config pm_to_blib subdirs linkext
+ $(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+ $(NOECHO) $(NOOP)
+
+config :: $(FIRST_MAKEFILE) blibdirs
+ $(NOECHO) $(NOOP)
+
+help :
+ perldoc ExtUtils::MakeMaker
+
+
+# --- MakeMaker blibdirs section:
+blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists \
$(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists \
$(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists \
$(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists + $(NOECHO) $(NOOP)
+
+# Backwards compat with 6.18 through 6.25
+blibdirs.ts : blibdirs
+ $(NOECHO) $(NOOP)
+
+$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_LIBDIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
+ $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
+
+$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
+ $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
+
+$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_AUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
+
+$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
+
+$(INST_BIN)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_BIN)
+ $(NOECHO) $(CHMOD) 755 $(INST_BIN)
+ $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
+
+$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_SCRIPT)
+ $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
+ $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
+
+$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
+
+$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
+
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+BOOTSTRAP = $(BASEEXT).bs
+
+# As Mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
+ $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+ $(NOECHO) $(PERLRUN) \
+ "-MExtUtils::Mkbootstrap" \
+ -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
+ $(NOECHO) $(TOUCH) $@
+ $(CHMOD) $(PERM_RW) $@
+
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists
+ $(NOECHO) $(RM_RF) $@
+ - $(CP) $(BOOTSTRAP) $@
+ $(CHMOD) $(PERM_RW) $@
+
+
+# --- MakeMaker dynamic_lib section:
+
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+ARMAYBE = :
+OTHERLDFLAGS =
+INST_DYNAMIC_DEP =
+INST_DYNAMIC_FIX =
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) \
$(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) \
$(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP) + $(RM_F) $@
+ $(LD) $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \
+ $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \
+ $(INST_DYNAMIC_FIX)
+ $(CHMOD) $(PERM_RWX) $@
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
+ $(RM_RF) $@
+ $(FULL_AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+ $(CHMOD) $(PERM_RWX) $@
+ $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+
+
+# --- MakeMaker manifypods section:
+
+POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
+POD2MAN = $(POD2MAN_EXE)
+
+
+manifypods : pure_all \
+ lib/LinuxRealTime.pm \
+ lib/LinuxRealTime.pm
+ $(NOECHO) $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) \
+ lib/LinuxRealTime.pm $(INST_MAN3DIR)/LinuxRealTime.$(MAN3EXT)
+
+
+
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean_subdirs section:
+clean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean :: clean_subdirs
+ - $(RM_F) \
+ *$(LIB_EXT) core \
+ core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
+ core.[0-9][0-9] $(BASEEXT).bso \
+ pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
+ $(BASEEXT).x $(BOOTSTRAP) \
+ perl$(EXE_EXT) tmon.out \
+ *$(OBJ_EXT) pm_to_blib \
+ $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \
+ core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
+ core.*perl.*.? $(MAKE_APERL_FILE) \
+ perl $(BASEEXT).def \
+ core.[0-9][0-9][0-9] mon.out \
+ lib$(BASEEXT).def perlmain.c \
+ perl.exe so_locations \
+ $(BASEEXT).exp
+ - $(RM_RF) \
+ blib
+ - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
+
+
+# --- MakeMaker realclean_subdirs section:
+realclean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker realclean section:
+# Delete temporary files (via clean) and also delete dist files
+realclean purge :: clean realclean_subdirs
+ - $(RM_F) \
+ $(OBJECT) $(MAKEFILE_OLD) \
+ $(FIRST_MAKEFILE)
+ - $(RM_RF) \
+ $(DISTVNAME)
+
+
+# --- MakeMaker metafile section:
+metafile : create_distdir
+ $(NOECHO) $(ECHO) Generating META.yml
+ $(NOECHO) $(ECHO) '# http://module-build.sourceforge.net/META-spec.html' > \
META_new.yml + $(NOECHO) $(ECHO) '#XXXXXXX This is a prototype!!! It will change in \
the future!!! XXXXX#' >> META_new.yml + $(NOECHO) $(ECHO) 'name: \
LinuxRealTime' >> META_new.yml + $(NOECHO) $(ECHO) 'version: 0.01' >> \
META_new.yml + $(NOECHO) $(ECHO) 'version_from: lib/LinuxRealTime.pm' >> META_new.yml
+ $(NOECHO) $(ECHO) 'installdirs: site' >> META_new.yml
+ $(NOECHO) $(ECHO) 'requires:' >> META_new.yml
+ $(NOECHO) $(ECHO) '' >> META_new.yml
+ $(NOECHO) $(ECHO) 'distribution_type: module' >> META_new.yml
+ $(NOECHO) $(ECHO) 'generated_by: ExtUtils::MakeMaker version 6.30' >> META_new.yml
+ -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
+
+
+# --- MakeMaker signature section:
+signature :
+ cpansign -s
+
+
+# --- MakeMaker dist_basics section:
+distclean :: realclean distcheck
+ $(NOECHO) $(NOOP)
+
+distcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
+
+skipcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
+
+manifest :
+ $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
+
+veryclean : realclean
+ $(RM_F) *~ *.orig */*~ */*.orig
+
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+ $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date \
with $(VERSION_FROM)'\''' \ + -e ' if -e '\''$(VERSION_FROM)'\'' and -M \
'\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' +
+tardist : $(DISTVNAME).tar$(SUFFIX)
+ $(NOECHO) $(NOOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+ uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > \
$(DISTVNAME).tar$(SUFFIX)_uu +
+$(DISTVNAME).tar$(SUFFIX) : distdir
+ $(PREOP)
+ $(TO_UNIX)
+ $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(COMPRESS) $(DISTVNAME).tar
+ $(POSTOP)
+
+zipdist : $(DISTVNAME).zip
+ $(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+ $(PREOP)
+ $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+shdist : distdir
+ $(PREOP)
+ $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+
+# --- MakeMaker distdir section:
+create_distdir :
+ $(RM_RF) $(DISTVNAME)
+ $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
+ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+distdir : create_distdir distmeta
+ $(NOECHO) $(NOOP)
+
+
+
+# --- MakeMaker dist_test section:
+disttest : distdir
+ cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
+ cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
+ cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
+
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+ $(PERLRUN) "-MExtUtils::Manifest=maniread" \
+ -e "@all = keys %{ maniread() };" \
+ -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
+ -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
+
+
+# --- MakeMaker distmeta section:
+distmeta : create_distdir metafile
+ $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { \
maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \ + -e ' \
or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' +
+
+
+# --- MakeMaker distsignature section:
+distsignature : create_distdir
+ $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { \
maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \ + -e \
' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' + $(NOECHO) cd \
$(DISTVNAME) && $(TOUCH) SIGNATURE + cd $(DISTVNAME) && cpansign -s
+
+
+
+# --- MakeMaker install section:
+
+install :: all pure_install doc_install
+ $(NOECHO) $(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+ $(NOECHO) $(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+ $(NOECHO) $(NOOP)
+
+install_vendor :: all pure_vendor_install doc_vendor_install
+ $(NOECHO) $(NOOP)
+
+pure_install :: pure_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+pure__install : pure_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
+ write $(DESTINSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(DESTINSTALLPRIVLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+ $(INST_BIN) $(DESTINSTALLBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+ write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(DESTINSTALLSITELIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+ $(INST_BIN) $(DESTINSTALLSITEBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+pure_vendor_install ::
+ $(NOECHO) $(MOD_INSTALL) \
+ read $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist \
+ write $(DESTINSTALLVENDORARCH)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(DESTINSTALLVENDORLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+ $(INST_BIN) $(DESTINSTALLVENDORBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
+
+doc_perl_install ::
+ $(NOECHO) $(ECHO) Appending installation info to \
$(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLPRIVLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)/perllocal.pod
+
+doc_site_install ::
+ $(NOECHO) $(ECHO) Appending installation info to \
$(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLSITELIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)/perllocal.pod
+
+doc_vendor_install ::
+ $(NOECHO) $(ECHO) Appending installation info to \
$(DESTINSTALLARCHLIB)/perllocal.pod + -$(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
+ -$(NOECHO) $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLVENDORLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLARCHLIB)/perllocal.pod
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+ $(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+ $(NOECHO) $(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_sitedirs ::
+ $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_vendordirs ::
+ $(NOECHO) $(UNINSTALL) $(VENDORARCHEXP)/auto/$(FULLEXT)/.packlist
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE:
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+PERL_HDRS = \
+ $(PERL_INC)/EXTERN.h \
+ $(PERL_INC)/INTERN.h \
+ $(PERL_INC)/XSUB.h \
+ $(PERL_INC)/av.h \
+ $(PERL_INC)/cc_runtime.h \
+ $(PERL_INC)/config.h \
+ $(PERL_INC)/cop.h \
+ $(PERL_INC)/cv.h \
+ $(PERL_INC)/dosish.h \
+ $(PERL_INC)/embed.h \
+ $(PERL_INC)/embedvar.h \
+ $(PERL_INC)/fakethr.h \
+ $(PERL_INC)/form.h \
+ $(PERL_INC)/gv.h \
+ $(PERL_INC)/handy.h \
+ $(PERL_INC)/hv.h \
+ $(PERL_INC)/intrpvar.h \
+ $(PERL_INC)/iperlsys.h \
+ $(PERL_INC)/keywords.h \
+ $(PERL_INC)/mg.h \
+ $(PERL_INC)/nostdio.h \
+ $(PERL_INC)/op.h \
+ $(PERL_INC)/opcode.h \
+ $(PERL_INC)/patchlevel.h \
+ $(PERL_INC)/perl.h \
+ $(PERL_INC)/perlio.h \
+ $(PERL_INC)/perlsdio.h \
+ $(PERL_INC)/perlsfio.h \
+ $(PERL_INC)/perlvars.h \
+ $(PERL_INC)/perly.h \
+ $(PERL_INC)/pp.h \
+ $(PERL_INC)/pp_proto.h \
+ $(PERL_INC)/proto.h \
+ $(PERL_INC)/regcomp.h \
+ $(PERL_INC)/regexp.h \
+ $(PERL_INC)/regnodes.h \
+ $(PERL_INC)/scope.h \
+ $(PERL_INC)/sv.h \
+ $(PERL_INC)/thrdvar.h \
+ $(PERL_INC)/thread.h \
+ $(PERL_INC)/unixish.h \
+ $(PERL_INC)/util.h
+
+$(OBJECT) : $(PERL_HDRS)
+
+
+# --- MakeMaker makefile section:
+
+$(OBJECT) : $(FIRST_MAKEFILE)
+
+# We take a very conservative approach here, but it's worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+ $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+ $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+ -$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+ -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+ - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+ $(PERLRUN) Makefile.PL
+ $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+ $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
+ false
+
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET = perl
+FULLPERL = /usr/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+ $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
+ $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+ $(NOECHO) $(PERLRUNINST) \
+ Makefile.PL DIR= \
+ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = t/*.t
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE)
+
+test_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" \
"test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) +
+testdb_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" \
$(TEST_FILE) +
+test_ : test_dynamic
+
+test_static :: pure_all $(MAP_TARGET)
+ PERL_DL_NONLAZY=1 ./$(MAP_TARGET) "-MExtUtils::Command::MM" "-e" \
"test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES) +
+testdb_static :: pure_all $(MAP_TARGET)
+ PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" \
$(TEST_FILE) +
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd:
+ $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="0,01,0,0">' > \
$(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <TITLE>$(DISTNAME)</TITLE>' >> \
$(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ABSTRACT>Perl extension for setting real \
time priority</ABSTRACT>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <AUTHOR>Daniel \
Zinn <q@></AUTHOR>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' \
<IMPLEMENTATION>' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <OS \
NAME="$(OSNAME)" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' <ARCHITECTURE \
NAME="i386-linux-thread-multi" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' \
<CODEBASE HREF="" />' >> $(DISTNAME).ppd + $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' \
>> $(DISTNAME).ppd + $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
+
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib : $(TO_INST_PM)
+ $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, \
'\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \ + lib/LinuxRealTime.pm \
blib/lib/LinuxRealTime.pm + $(NOECHO) $(TOUCH) pm_to_blib
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+
+
+# End.
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile.PL
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile.PL 2006-06-20 14:01:05 \
UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/Makefile.PL 2006-06-20 15:15:48 \
UTC (rev 2239) @@ -0,0 +1,12 @@
+use 5.008004;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'LinuxRealTime',
+ VERSION_FROM => 'lib/LinuxRealTime.pm', # finds $VERSION
+ PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/LinuxRealTime.pm', # retrieve abstract from module
+ AUTHOR => 'Daniel Zinn <q@>') : ()),
+);
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/README
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/README 2006-06-20 14:01:05 UTC \
(rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/README 2006-06-20 15:15:48 UTC \
(rev 2239) @@ -0,0 +1,26 @@
+LinuxRealTime version 0.01
+==========================
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ DynaLoader Exporter
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005 by Daniel Zinn
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/LinuxRealTime.bs
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/LinuxRealTime.so
===================================================================
(Binary files differ)
Property changes on: \
trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/arch/auto/LinuxRealTime/LinuxRealTime.so
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:mime-type
+ application/octet-stream
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/bin/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/LinuxRealTime.pm
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/LinuxRealTime.pm 2006-06-20 \
14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/LinuxRealTime.pm 2006-06-20 \
15:15:48 UTC (rev 2239) @@ -0,0 +1,71 @@
+package LinuxRealTime;
+
+# Thanks to SWIG for creating parts of this file
+
+require Exporter;
+require DynaLoader;
+
+our @ISA = qw(Exporter DynaLoader);
+our @EXPORT = qw();
+
+package LinuxRealTimec;
+bootstrap LinuxRealTime;
+package LinuxRealTime;
+
+our $VERSION = '0.01';
+
+*setRealTime = *LinuxRealTimec::setRealTime;
+
+1;
+__END__
+
+=head1 NAME
+
+LinuxRealTime - Perl extension for setting real time priority
+
+=head1 SYNOPSIS
+
+ use LinuxRealTime;
+ LinuxRealTime::setRealTime(10);
+
+ # freeze the computer for a while
+ my $j; my $i;
+ foreach $j (0..30_000_000)
+ { $i = sqrt ($j); }
+
+=head1 DESCRIPTION
+
+Calling LinuxRealTime::setRealTime(10) sets the scheduling method of the current \
task +to SCHED_FIFO with a priority of 10 (if the script is executed by root). The \
parameter +specifies the priority, so different scripts can run with different \
priorities. +
+SCHED_FIFO is used to build real time applications. The linux kernel (>= 2.6)
+schedules all tasks using SCHED_FIFO _before_ any other "interactive task".
+Therefore all CPU resources are then used by the Perl skript.
+
+This can be used to meassure execution times or to build real time applications.
+
+!!!!! BE CAREFULL !!!!!
+Be CAREFULL with scripts that have long execution times. Once started as root,
+you will not even be able to send a CTRL-C to your script as the shell or X
+won't get any CPU ressources.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Daniel Zinn, E<lt>perl-public@qmic.de<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Daniel Zinn
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/lib/auto/LinuxRealTime/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man1/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/LinuxRealTime.3pm
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/LinuxRealTime.3pm 2006-06-20 \
14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/man3/LinuxRealTime.3pm 2006-06-20 \
15:15:48 UTC (rev 2239) @@ -0,0 +1,177 @@
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sh \" Subsection heading
+.br
+.if t .Sp
+.ne 5
+.PP
+\fB\\$1\fR
+.PP
+..
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings. \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote. | will give a
+.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used to
+.\" do unbreakable dashes and therefore won't be available. \*(C` and \*(C'
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
+.tr \(*W-|\(bv\*(Tr
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+. ds -- \(*W-
+. ds PI pi
+. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
+. ds L" ""
+. ds R" ""
+. ds C` ""
+. ds C' ""
+'br\}
+.el\{\
+. ds -- \|\(em\|
+. ds PI \(*p
+. ds L" ``
+. ds R" ''
+'br\}
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
+.\" entries marked with X<> in POD. Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.if \nF \{\
+. de IX
+. tm Index:\\$1\t\\n%\t"\\$2"
+..
+. nr % 0
+. rr F
+.\}
+.\"
+.\" For nroff, turn off justification. Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.hy 0
+.if n .na
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear. Run. Save yourself. No user-serviceable parts.
+. \" fudge factors for nroff and troff
+.if n \{\
+. ds #H 0
+. ds #V .8m
+. ds #F .3m
+. ds #[ \f1
+. ds #] \fP
+.\}
+.if t \{\
+. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+. ds #V .6m
+. ds #F 0
+. ds #[ \&
+. ds #] \&
+.\}
+. \" simple accents for nroff and troff
+.if n \{\
+. ds ' \&
+. ds ` \&
+. ds ^ \&
+. ds , \&
+. ds ~ ~
+. ds /
+.\}
+.if t \{\
+. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+. \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+. \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+. \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+. ds : e
+. ds 8 ss
+. ds o a
+. ds d- d\h'-1'\(ga
+. ds D- D\h'-1'\(hy
+. ds th \o'bp'
+. ds Th \o'LP'
+. ds ae ae
+. ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "LinuxRealTime 3"
+.TH LinuxRealTime 3 "2005-08-15" "perl v5.8.8" "User Contributed Perl Documentation"
+.SH "NAME"
+LinuxRealTime \- Perl extension for setting real time priority
+.SH "SYNOPSIS"
+.IX Header "SYNOPSIS"
+.Vb 2
+\& use LinuxRealTime;
+\& LinuxRealTime::setRealTime(10);
+.Ve
+.PP
+.Vb 4
+\& # freeze the computer for a while
+\& my $j; my $i;
+\& foreach $j (0..30_000_000)
+\& { $i = sqrt ($j); }
+.Ve
+.SH "DESCRIPTION"
+.IX Header "DESCRIPTION"
+Calling LinuxRealTime::setRealTime(10) sets the scheduling method of the current \
task +to \s-1SCHED_FIFO\s0 with a priority of 10 (if the script is executed by root). \
The parameter +specifies the priority, so different scripts can run with different \
priorities. +.PP
+\&\s-1SCHED_FIFO\s0 is used to build real time applications. The linux kernel (>= \
2.6) +schedules all tasks using \s-1SCHED_FIFO\s0 _before_ any other \
\*(L"interactive task\*(R". +Therefore all \s-1CPU\s0 resources are then used by the \
Perl skript. +.PP
+This can be used to meassure execution times or to build real time applications.
+.PP
+!!!!! \s-1BE\s0 \s-1CAREFULL\s0 !!!!!
+Be \s-1CAREFULL\s0 with scripts that have long execution times. Once started as \
root, +you will not even be able to send a CTRL-C to your script as the shell or X
+won't get any \s-1CPU\s0 ressources.
+.Sh "\s-1EXPORT\s0"
+.IX Subsection "EXPORT"
+None by default.
+.SH "SEE ALSO"
+.IX Header "SEE ALSO"
+.SH "AUTHOR"
+.IX Header "AUTHOR"
+Daniel Zinn, <perl\-public@qmic.de<gt>
+.SH "COPYRIGHT AND LICENSE"
+.IX Header "COPYRIGHT AND LICENSE"
+Copyright (C) 2005 by Daniel Zinn
+.PP
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/blib/script/.exists
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/lib/LinuxRealTime.pm
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/lib/LinuxRealTime.pm 2006-06-20 \
14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/lib/LinuxRealTime.pm 2006-06-20 \
15:15:48 UTC (rev 2239) @@ -0,0 +1,71 @@
+package LinuxRealTime;
+
+# Thanks to SWIG for creating parts of this file
+
+require Exporter;
+require DynaLoader;
+
+our @ISA = qw(Exporter DynaLoader);
+our @EXPORT = qw();
+
+package LinuxRealTimec;
+bootstrap LinuxRealTime;
+package LinuxRealTime;
+
+our $VERSION = '0.01';
+
+*setRealTime = *LinuxRealTimec::setRealTime;
+
+1;
+__END__
+
+=head1 NAME
+
+LinuxRealTime - Perl extension for setting real time priority
+
+=head1 SYNOPSIS
+
+ use LinuxRealTime;
+ LinuxRealTime::setRealTime(10);
+
+ # freeze the computer for a while
+ my $j; my $i;
+ foreach $j (0..30_000_000)
+ { $i = sqrt ($j); }
+
+=head1 DESCRIPTION
+
+Calling LinuxRealTime::setRealTime(10) sets the scheduling method of the current \
task +to SCHED_FIFO with a priority of 10 (if the script is executed by root). The \
parameter +specifies the priority, so different scripts can run with different \
priorities. +
+SCHED_FIFO is used to build real time applications. The linux kernel (>= 2.6)
+schedules all tasks using SCHED_FIFO _before_ any other "interactive task".
+Therefore all CPU resources are then used by the Perl skript.
+
+This can be used to meassure execution times or to build real time applications.
+
+!!!!! BE CAREFULL !!!!!
+Be CAREFULL with scripts that have long execution times. Once started as root,
+you will not even be able to send a CTRL-C to your script as the shell or X
+won't get any CPU ressources.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Daniel Zinn, E<lt>perl-public@qmic.de<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Daniel Zinn
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/pm_to_blib
===================================================================
Added: trunk/testing/testsuite/tests/LinuxRealTime-0.01/t/LinuxRealTime.t
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime-0.01/t/LinuxRealTime.t 2006-06-20 \
14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime-0.01/t/LinuxRealTime.t 2006-06-20 \
15:15:48 UTC (rev 2239) @@ -0,0 +1,17 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl LinuxRealTime.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('LinuxRealTime') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+LinuxRealTime::setRealTime(10);
+print "OK\n";
Added: trunk/testing/testsuite/tests/LinuxRealTime.pm
===================================================================
--- trunk/testing/testsuite/tests/LinuxRealTime.pm 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/LinuxRealTime.pm 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,71 @@
+package LinuxRealTime;
+
+# Thanks to SWIG for creating parts of this file
+
+require Exporter;
+require DynaLoader;
+
+our @ISA = qw(Exporter DynaLoader);
+our @EXPORT = qw();
+
+package LinuxRealTimec;
+bootstrap LinuxRealTime;
+package LinuxRealTime;
+
+our $VERSION = '0.01';
+
+*setRealTime = *LinuxRealTimec::setRealTime;
+
+1;
+__END__
+
+=head1 NAME
+
+LinuxRealTime - Perl extension for setting real time priority
+
+=head1 SYNOPSIS
+
+ use LinuxRealTime;
+ LinuxRealTime::setRealTime(10);
+
+ # freeze the computer for a while
+ my $j; my $i;
+ foreach $j (0..30_000_000)
+ { $i = sqrt ($j); }
+
+=head1 DESCRIPTION
+
+Calling LinuxRealTime::setRealTime(10) sets the scheduling method of the current \
task +to SCHED_FIFO with a priority of 10 (if the script is executed by root). The \
parameter +specifies the priority, so different scripts can run with different \
priorities. +
+SCHED_FIFO is used to build real time applications. The linux kernel (>= 2.6)
+schedules all tasks using SCHED_FIFO _before_ any other "interactive task".
+Therefore all CPU resources are then used by the Perl skript.
+
+This can be used to meassure execution times or to build real time applications.
+
+!!!!! BE CAREFULL !!!!!
+Be CAREFULL with scripts that have long execution times. Once started as root,
+you will not even be able to send a CTRL-C to your script as the shell or X
+won't get any CPU ressources.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Daniel Zinn, E<lt>perl-public@qmic.de<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Daniel Zinn
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
Added: trunk/testing/testsuite/tests/LinuxRealTime.so
===================================================================
(Binary files differ)
Property changes on: trunk/testing/testsuite/tests/LinuxRealTime.so
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:mime-type
+ application/octet-stream
Added: trunk/testing/testsuite/tests/README
===================================================================
--- trunk/testing/testsuite/tests/README 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/README 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,5 @@
+DRBD TestSuite
+
+Scripts in this directory or any subdirectories are for testing purpose
+only and are not part of the TestSuite itself.
+
Added: trunk/testing/testsuite/tests/caller.pl
===================================================================
--- trunk/testing/testsuite/tests/caller.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/caller.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+#
+
+use IO::Socket;
+my $sock = new IO::Socket::INET (
+ PeerAddr => '127.0.0.1',
+ PeerPort => '4000',
+ Proto => 'tcp',
+);
+die "Could not create socket: $!\n" unless $sock;
+print $sock "Hello there!\n";
+close($sock);
+
Property changes on: trunk/testing/testsuite/tests/caller.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/tests/eval.pl
===================================================================
--- trunk/testing/testsuite/tests/eval.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/eval.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+#
+#
+
+$numArg = 1;
+
+sub rc {
+ ++$numArg;
+ return "timestamp: ". $_[0];
+}
+
+sub n1 {
+ return "127.0.0.1";
+}
+
+sub cmd {
+ ++$numArg;
+ print $_[1];
+ return "Execute Command: '". $_[0]."'";
+}
+
+sub on {
+ print $_[2]."\n";
+ return;
+ my $node = $_[0];
+ print "on ".$node." do: ";
+ for ($i = 0; $i < $numArg; ++$i) {
+ print $_[$i+1];
+ }
+ print $_[2];
+
+ print "\n";
+ return true;
+}
+
+sub timeout {
+ ++$numArg;
+ return "Max Wait Time = ". $_[0];
+}
+
+sub excpect {
+ if (1 != 2) { die("unexpected state"); };
+}
+
+# cmd 'drbdadm create-md r0' rc 0;
+# cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi r0' rc 0; #no sync on connect!
+# on n1 cmd 'drbdadm up r0' rc 0;
+# on n2 cmd 'drbdadm up r0' rc 0;
+# exp cs Connected timeo 10;
+# sleep 10;
+
+
+on n1, cmd 'drbdadm create-md r0', rc 0, timeout 5;
+
+exit 0;
+
+#eval{
+# on n1 cmd "drbdadm up r0";
+# cmd 'drbdadm create-md r0';
+# sleep 1;
+# expect cs Connected timeout 10;
+#}; # warn $@ if $@;
+#if ($@) {
+# print $@;
+# print "XXXXXXXXXx\n";
+#}
+
+
+
+exit 0;
Property changes on: trunk/testing/testsuite/tests/eval.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/tests/eval2.pl
===================================================================
--- trunk/testing/testsuite/tests/eval2.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/eval2.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+#
+#
+#
+
+$timeout = 0;
+$rc = 0;
+$node = "";
+$cmd = "";
+$state = "";
+
+
+sub listNodes {
+ ($node eq "")?"all":$node;
+}
+
+sub rc {
+ $rc = $_[0];
+}
+
+sub on {
+ $node = $_[0];
+}
+
+sub timeout {
+ $timeout = $_[0];
+}
+
+sub cmd {
+ print "Trying to run:\n";
+ print "Command: ".$_[0]."\n";
+ print "On: ".eval(listNodes)."\n";
+ print "Timeout: ".$timeout."\n";
+ print "Timestamp: ".$rc."\n\n";
+}
+
+sub excpect {
+ if (1 != 2) { die("unexpected state"); };
+}
+
+# cmd 'drbdadm create-md r0' rc 0;
+# cmd 'drbdadm -- DDFFC66571C5E5CB::::1 set-gi r0' rc 0; #no sync on connect!
+# on n1 cmd 'drbdadm up r0' rc 0;
+# on n2 cmd 'drbdadm up r0' rc 0;
+# exp cs Connected timeo 10;
+# sleep 10;
+
+eval {
+ cmd 'drbdadm create-md r0', timeout 15, rc 4;
+ cmd 'drbdadm primary r0', on n1, timeout 5;
+};
+
+exit 0;
+
+#eval{
+# on n1 cmd "drbdadm up r0";
+# cmd 'drbdadm create-md r0';
+# sleep 1;
+# expect cs Connected timeout 10;
+#}; # warn $@ if $@;
+#if ($@) {
+# print $@;
+# print "XXXXXXXXXx\n";
+#}
+
+
+
+exit 0;
Property changes on: trunk/testing/testsuite/tests/eval2.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/tests/receiver.pl
===================================================================
--- trunk/testing/testsuite/tests/receiver.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/receiver.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+#
+
+use IO::Socket;
+my $sock = new IO::Socket::INET (
+ LocalHost => '127.0.0.1',
+ LocalPort => '4000',
+ Proto => 'tcp',
+ Listen => 1,
+ Reuse => 1,
+);
+die "Could not create socket: $!\n" unless $sock;
+
+my $new_sock = $sock->accept();
+while(<$new_sock>) {
+ print $_;
+}
+close($sock);
+
+print "exit\n";
+exit 0;
Property changes on: trunk/testing/testsuite/tests/receiver.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/tests/run.pl
===================================================================
--- trunk/testing/testsuite/tests/run.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/tests/run.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+#
+
+sub cmd {
+ if (!$rc) { $rc = 0; }
+ print "rc = $rc\n";
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" };
+ alarm $timeout;
+ $x = `$command`;
+ alarm 0;
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ print "TIMEOUT\n";
+ }
+ else {
+ print "FINISHED IN TIME\n";
+
+ print $x;
+ }
+}
+
+require 'sys/syscall.ph';
+$x = syscall(&SYS_sched_setscheduler(0, 'SCHED_FIFO', 99));
+print $x;
+
+use LinuxRealTime;
+LinuxRealTime::setRealTime(99);
+
+
+#$TIMEVAL_T = "LL";
+#$done = $start = pack($TIMEVAL_T, ());
+#syscall(&SYS_gettimeofday, $start, 0) != -1
+# or die "gettimeofday: $!";
+#@start = unpack($TIMEVAL_T, $start);
+
+#$time = $start[0].$start[1];
+#print $time."\n";
+#$time2 = "1146225000000000";
+#print (($time2 - $time) / 100000000). "\n";
+#exit 0;
+#eval {
+# local $SIG{ALRM} = sub { print "XXXXXXXXX"; die "alarm\n" };
+# select(undef,undef,undef,$x);
+#};
+
+use Time::HiRes qw(ualarm nanosleep usleep gettimeofday tv_interval);
+
+for ($i = 0; $i < 5; ++$i) {
+ $t0 = [gettimeofday];
+ nanosleep(Time::HiRes::time + 2_000_000_000 - Time::HiRes::time);
+ $elapsed = tv_interval ( $t0, [gettimeofday]);
+ print $elapsed."\n";
+}
+
+#cmd($command = 'cat /proc/cpuinfo |grep MHz', $timeout = 1, $rc = 4);
+
+for ($i = 0; $i < 5; ++$i)
+{
+ ualarm(50_000_000);
+ $t0 = [gettimeofday];
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n" };
+ sleep(10);
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ print "TIMEOUT\n";
+ $elapsed = tv_interval ( $t0, [gettimeofday]);
+ print $elapsed."\n";
+ }
+}
+
+
+
+
+exit 0;
Property changes on: trunk/testing/testsuite/tests/run.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/testing/testsuite/testsuite.conf
===================================================================
--- trunk/testing/testsuite/testsuite.conf 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/testsuite.conf 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,117 @@
+# Configuration file of the testsuite.pl
+#
+# Use to configure both nodes and to change default commands of the testsuite.
+# Important: after each argument put ; to finish the line otherwise it will not be \
set and can cause errors! +
+# Configuration of one Node
+node node1 {
+ # Syntax: addr <ip>
+ # IP Address of the node that is visible to the internet. If this is left \
undefined + # the testsuite will not start.
+ #
+ # Example: addr 192.168.1.10;
+ #
+ addr 10.25.91.10;
+
+ # Syntax: port <p>
+ # The port the testsuite will try to connect to. If this is left undefined
+ # the testsuite will not start.
+ #
+ # Example: port 4000;
+ #
+ port 4000;
+}
+
+# Configuration of second Node
+node node2 {
+ # Syntax: addr <ip>
+ # IP Address of the node that is visible to the internet. If this is left \
undefined + # the testsuite will not start.
+ #
+ # Example: addr 192.168.1.10;
+ #
+ addr 10.25.91.11;
+
+ # Syntax: port <p>
+ # The port the testsuite will try to connect to. If this is left undefined
+ # the testsuite will not start.
+ #
+ # Example: port 4000;
+ #
+ port 4000;
+}
+
+# Set of default parameters of the testsuite
+defaults {
+ # Syntax: timeout <n>
+ # Generall timeout limit of <n> seconds for the response of the executed command.
+ #
+ # If this is left undefined default is to wait 0 seconds = wait forever.
+ #
+ # Example: timeout 20;
+ #
+ timeout 10;
+
+ # Syntax: latency <l>
+ #
+ # The maximum time/clock difference between the two agents. If it's above
+ # the given value, FIXME => sync
+ #
+ # If this is left undefined default latency is 0.5 seconds
+ #
+ # Example: latency 0.05;
+ #
+ latency 0.02;
+
+ # Syntax: connect_timeout <n>
+ # Timeout after trying to establish a connection after <n> seconds
+ #
+ # If this is left undefined default is to wait 3 seconds.
+ #
+ # Example: connect_timeout 1;
+ #
+ connect_timeout 1;
+
+ # Syntax: timeserver <ip/host>
+ # If nodes are out of sync, ntpdate <ip/host> will be sent to each node.
+ #
+ # If no timeserver is given, the testsuite will abort instead of trying
+ # to syncronize the agents.
+ #
+ timeserver 10.25.91.12;
+}
+
+# Set of sequence commands to be executet on the nodes. See README for detailed
+# information about available commands.
+seq-commands {
+
+ # check if we are in a stable state
+ if ((get 'drbdsetup /dev/drbd0 state', on node1) =~ /Unknown/) {
+ VERBOSE ("trouble with drbd on agents");
+ die();
+ }
+
+ # switch from secondary to primary for a few times
+ for (my $i = 0; $i < 3; ++$i) {
+ cmd secondary;
+ cmd primary, on node1;
+ }
+
+ # switch to secondary by given command
+ cmd '/sbin/drbdadm secondary {resource}';
+
+ # both agents should have following state within one second
+ expected 'st', state 'Secondary/Secondary', timeout 1;
+
+ # block network traffic on both nodes
+ cmd link_down;
+
+ # loss of connection should be detected within 15 seconds
+ expected 'cs', state 'WFConnection', timeout 15;
+
+ # accept network traffic on both nodes, sleep 3 seconds and request state
+ cmd link_up;
+ sleep 3;
+ get 'drbdsetup /dev/drbd0 cstate', on node1;
+}
+
Added: trunk/testing/testsuite/testsuite.pl
===================================================================
--- trunk/testing/testsuite/testsuite.pl 2006-06-20 14:01:05 UTC (rev 2238)
+++ trunk/testing/testsuite/testsuite.pl 2006-06-20 15:15:48 UTC (rev 2239)
@@ -0,0 +1,994 @@
+#!/usr/bin/perl -W
+
+# DRBD TestSuite
+#
+# (c)2006 by Dworschak, Roland <roland.dworschak@fh-hagenberg.at>
+# Hofmann, Florian <florian.hofmann@fh-hagenberg.at>
+# Huber, Sabine <sabine.huber@fh-hagenberg.at>
+# Leitner, Alexander <alexander.leitner@fh-hagenberg.at>
+# Poettinger, Joachim <joachim.poettinger@fh-hagenberg.at>
+#
+# Licensed under the GNU GPL v2
+# see http://www.gnu.org for more details
+#
+
+my $version = 'v1.00';
+
+use Time::HiRes qw(gettimeofday);
+use Time::Local;
+use IO::Socket;
+use threads;
+use threads::shared;
+
+# program variables
+use vars qw (
+ $pid $cpid
+ $opt_c $opt_h $opt_d $opt_v $opt_i $opt_l
+ $outreply $outcommand
+ %config @seqcommands
+ %seqvars
+ %commands
+ @logList
+ %verbose
+ $terminated_node $terminated
+ $seriallog
+);
+
+$seriallog = "";
+$SIG{USR1} = 'IGNORE';
+$SIG{USR2} = 'IGNORE';
+$SIG{PIPE} = 'IGNORE';
+$SIG{TERM} = 'IGNORE';
+
+###############################################################################
+###### commands
+###############################################################################
+
+#GENERAL:
+$commands{'cpuinfo'} = 'cat /proc/cpuinfo | grep MH | awk -F: \'{print $2}\'';
+$commands{'tiobench'} = 'tiobench -- dir {mountpoint}';
+
+#DEVICE MAPPER:
+$commands{'dm_deviceremoveOne'} = 'dmsetup remove {lvm_device}';
+$commands{'dm_deviceinfo'} = 'dmsetup info {lvm_device}';
+$commands{'dm_devicemake'} = 'dmsetup create {lvm_device}';
+$commands{'dm_devicestatus'} = 'dmsetup status {lvm_device}';
+$commands{'dm_devicesuspend'} = 'dmsetup suspend {lvm_device}';
+$commands{'dm_deviceresume'} = 'dmsetup resume {lvm_device}';
+
+#STATES:
+$commands{'state_st'} = '/sbin/drbdsetup /dev/{device} state';
+$commands{'state_cs'} = '/sbin/drbdsetup /dev/{device} cstate';
+$commands{'state_ds'} = '/sbin/drbdsetup /dev/{device} dstate';
+$commands{'state_iptables'} = 'iptables -L OUTPUT -nv'; #FIXME: not yet implemented
+
+#NETWORK:
+$commands{'link_down'} = '/sbin/iptables -I OUTPUT -o {interface} -j DROP';
+$commands{'link_up'} = '/sbin/iptables -F OUTPUT';
+
+#DRBD-SPECIFIC:
+$commands{'primary'} = '/sbin/drbdadm primary {resource}';
+$commands{'secondary'} = '/sbin/drbdadm secondary {resource}';
+$commands{'drbd_fullsync'} = 'drbdadm -- --overwrite-data-of-peer {resource}';
+$commands{'drbd_turnoffnw'} = 'iptables -I OUTPUT -o {interface} -j DROP';
+$commands{'drbd_turnonnw'} = 'iptables -I OUTPUT -o {interface} -j DROP';
+$commands{'drbd_start'} = '/etc/init.d/drbd start';
+$commands{'drbd_stop'} = '/etc/init.d/drbd stop';
+$commands{'drbd_restart'} = '/etc/init.d/drbd restart';
+$commands{'drbd_mount'} = 'mount /dev/{device} {mountpoint}';
+$commands{'drbd_umount'} = 'umount /dev/{device}';
+$commands{'drbd_loaded'} = 'lsmod | grep drdb';
+$commands{'drbd_make'} = 'drbdadm create-md {resource}';
+
+#FILESYSTEM:
+$commands{'fs_make'} = 'mkfs.{filesystem} /dev/{device}'; #FIXME FileSystem - \
agent.conf!!' +
+###############################################################################
+
+require 'getopts.pl';
+if ( ! Getopts ('hc:vdil:') ) {
+ usage();
+ exit 1;
+}
+
+if (defined($opt_h)) {
+ usage();
+ exit 0;
+}
+
+if (defined($opt_d)) {
+ print "DEBUG activated!\n";
+}
+
+# show usage information
+sub usage {
+ print "TestSuite $version \n";
+ print "testsuite.pl [ -hd ] [ -c config ] [ -l logfile ]\n";
+ print " -h shows help\n";
+ print " -i ignore connection info\n";
+ print " -v verbose mode\n";
+ print " -d run in debug mode (console output)\n";
+ print " -c specifiy a configuration file other than the default \
(testsuite.conf)\n"; + print " -l writes all information to specified logfile\n";
+
+ return;
+}
+
+
+###############################################################################
+###### functions
+###############################################################################
+
+sub load_conf {
+ if (!defined($opt_c)) {
+ $opt_c = "testsuite.conf";
+ }
+ if (! -e $opt_c) {
+ die "Configuration file not availiable!\n";
+ }
+ open (CONF, $opt_c) or die "Cannot read the config file $opt_c, $!\n";
+
+ my $section = 0;
+ my $nodes = 0;
+ my $seqsection = 0; # {} sections in seq-commands
+
+ #initiate variables
+ $config{'node1addr'} = "";
+ $config{'node1port'} = "";
+ $config{'node2addr'} = "";
+ $config{'node2port'} = "";
+ $config{'timeout'} = "";
+ $config{'latency'} = 0;
+ $config{'max_latency'} = 0.5;
+ $config{'connect_timeout'} = 3;
+ $config{'timeserver'} = "";
+
+ while (<CONF>) {
+ next if (/^\s*$/); #skip blank lines
+ next if (/^\s*#/); # skip comment lines
+ $_ = trim($_);
+
+ if (/^}$/ and $seqsection == 0) {
+ $section = 0;
+ }
+ elsif ($section == 4) {
+ push @seqcommands, $_;
+ if (/{/) {
+ $seqsection = 1;
+ }
+ if (/}/) {
+ $seqsection = 0;
+ }
+ }
+ elsif ($section == 1 or $section == 2) {
+ if (/^addr\s+(.*);$/) { # addr <hostname/ip>;
+ if ($nodes == 1 or $nodes == 2) {
+ $config{'node'.$nodes.'addr'} = $1;
+ }
+ else {
+ ERROR ("ip without node configuration");
+ }
+ }
+ elsif (/^port\s+(.*);$/) { # port <port>;
+ if ($nodes == 1 or $nodes == 2) {
+ $config{'node'.$nodes.'port'} = $1;
+ }
+ else {
+ ERROR ("port without node configuration");
+ }
+ }
+ else {
+ ERROR ("unknown configuration at node: ".$_);
+ }
+ }
+ elsif ($section == 3) {
+ if (/^timeout\s+(.*);$/) {
+ $config{'timeout'} = $1;
+ }
+ elsif (/^latency\s+(.*);$/) {
+ $config{'max_latency'} = $1;
+ }
+ elsif (/^connect_timeout\s+([0-9]+);$/) {
+ $config{'connect_timeout'} = $1;
+ }
+ elsif (/^timeserver\s+(.*);$/) {
+ $config{'timeserver'} = $1;
+ }
+ else {
+ ERROR ("unknown configuration in default section: ".$_);
+ }
+ }
+ elsif (/^node\ (.*)\ ?{$/) {
+ $section = 1;
+ $nodes++;
+ $config{'node'.$nodes.'name'} = trim($1);
+ }
+ elsif (/defaults\s{/) {
+ $section = 3;
+ }
+ elsif (/seq-commands\s{/) {
+ $section = 4;
+ }
+ else {
+ ERROR ("unknown configuration");
+ }
+ }
+}
+
+# creates sockets for both nodes
+sub get_sockets {
+ eval {
+ $config{'node1'} = new IO::Socket::INET (
+ PeerAddr => $config{'node1addr'},
+ PeerPort => $config{'node1port'},
+ Proto => 'tcp',
+ Timeout => $config{'connect_timeout'},
+ ) or die("node1\n");
+
+ $config{'node2'} = new IO::Socket::INET (
+ PeerAddr => $config{'node2addr'},
+ PeerPort => $config{'node2port'},
+ Proto => 'tcp',
+ Timeout => $config{'connect_timeout'},
+ ) or die("node2\n");
+ };
+ if ($@) {
+ if ($terminated) {
+ $terminated_node = "Lost connection to " .$@;
+ }
+ else {
+ ERROR ("Can't connect to " .$@);
+ }
+ }
+
+ return;
+}
+
+# someone tried to kill parent process
+sub kill_parent {
+ $terminated = 1;
+ $terminated_node = "";
+ get_sockets();
+
+ if ($terminated_node eq "") {
+ WARN ("Received INT signal");
+ }
+ else {
+ WARN ($terminated_node);
+ }
+
+ show_report();
+ exit 0;
+}
+
+###############################################################################
+###### eval part
+###############################################################################
+
+# time that agent may need to execute requested command
+sub timeout {
+ $seqvars{'timeout'} = $_[0];
+ return 1;
+}
+
+# timestamp when the command should be executed
+sub rc {
+ # uses $config{'latency'}
+ $seqvars{'rc'} = ($_[0] == 0)?(Time::HiRes::time):(Time::HiRes::time + \
$config{'latency'} + $_[0]); + return 1;
+}
+
+# command will be sent to that node
+sub on {
+ $seqvars{'on'} = $_[0];
+ return 1;
+}
+
+# type of state (st, cs, ds, ...)
+sub type {
+ $seqvars{'type'} = $_[0];
+ return 1;
+}
+
+# value of state ('Primary/Secondary', 'Connected', ...)
+sub state {
+ $seqvars{'state'} = $_[0];
+ return 1;
+}
+
+# send 'execute command' to agent(s)
+sub cmd {
+ my $command = "execute (q{$_[0]}, $seqvars{'timeout'}, $seqvars{'rc'});";
+ $seqvars{'seq_type'} = 1;
+
+ VERBOSE ("$_[0]", $seqvars{'on'});
+
+ send_command($command) || die ("cmd failed\n");
+ set_default_vars();
+
+ return 1;
+}
+
+# send 'expected command' to agent(s)
+sub expected {
+ my $command = "execute (q{$commands{'state_'.$_[0]}}, $seqvars{'timeout'}, \
$seqvars{'rc'}, q{$seqvars{'state'}});"; + $seqvars{'seq_type'} = 2;
+
+ VERBOSE ("$commands{'state_'.$_[0]}", $seqvars{'on'});
+
+ send_command($command) || die ("expected failed\n");
+ set_default_vars();
+
+ return 1;
+}
+
+# send 'get command' to agent(s)
+sub get {
+ my $command = "execute (q{$_[0]}, $seqvars{'timeout'}, $seqvars{'rc'});";
+ $seqvars{'seq_type'} = 3;
+
+ VERBOSE ("$_[0]", $seqvars{'on'});
+
+ my $reply = send_command($command) || die ("get failed\n");
+ set_default_vars();
+
+ return $reply;
+}
+
+
+###############################################################################
+###### functions
+###############################################################################
+
+sub send_command {
+ my ($command) = @_;
+ my @reply;
+
+
+ if ($seqvars{'on'} > 0) { # only one node
+ print {$config{'node'.$seqvars{'on'}}} $command."\n";
+ push @reply, wait_for_reply($seqvars{'on'});
+ }
+ else {
+ my $local_reply;
+
+ my $pid1 = open(CHILD1, "-|");
+ if ($pid1 == 0) {
+ print {$config{'node1'}} $command."\n";
+ print STDOUT wait_for_reply(1);
+
+ exit 0;
+ }
+
+ my $pid2 = open(CHILD2, "-|");
+ if ($pid2 == 0) {
+ print {$config{'node2'}} $command."\n";
+ print STDOUT wait_for_reply(2);
+
+ exit 0;
+ }
+
+ $local_reply = "";
+ while (<CHILD1>) {
+ $local_reply .= $_;
+ }
+ push @reply, $local_reply;
+
+ $local_reply = "";
+ while (<CHILD2>) {
+ $local_reply .= $_;
+ }
+ push @reply, $local_reply;
+ }
+
+ return process_reply($command, @reply);
+}
+
+# sync time on specified node
+sub sync_node() {
+ set_default_vars();
+ $seqvars{'timeout'} = 10;
+
+ # FIXME, use config vars
+ my @reply = send_command("execute (q{".'ntpdate -b '.$config{'timeserver'}."}, \
$seqvars{'timeout'}, $seqvars{'rc'});"); +
+ return;
+}
+
+
+# process latency and timestamp of nodes
+sub parse_time_details {
+ my ($input) = @_;
+
+ if ($input =~ /^([1-2])\ ([0-9.]+)\ ([0-9.-]+)$/) {
+ return ($2, $3, $1);
+ }
+
+ return 0;
+}
+
+# check system time, get latency and sync nodes if needed
+sub get_connection_info {
+ my ($tries) = @_;
+ if (!defined($tries)) { $tries = 0; }
+
+ set_default_vars();
+
+ my $timestamp = Time::HiRes::time;
+ my $command = "setup ($timestamp)";
+ my @reply = send_command($command);
+ my $timestamp_sent = Time::HiRes::time;
+
+ my $time_difference;
+ my $node1;
+ my $node2;
+
+ my $n1_latency;
+ my $n2_latency;
+
+ ($time_difference, $n1_latency, $node1) = parse_time_details($reply[0]);
+ ($time_difference, $n2_latency, $node2) = parse_time_details($reply[1]);
+
+ if ( !defined($n1_latency) ) {
+ ERROR ("Node timed out on setup");
+ }
+ elsif ( !defined($n2_latency) ) {
+ ERROR ("Node timed out on setup");
+ }
+
+ VERBOSE ("Node time difference: ".abs($n1_latency - $n2_latency));
+
+ if ( abs($n1_latency - $n2_latency) > $config{'max_latency'} ) {
+ if ($tries > 2) {
+ ERROR ("Couldn't sync nodes: ".abs($n1_latency - $n2_latency)." - abort after \
3 retries."); + exit 0;
+ }
+
+ if ($config{'timeserver'} ne "") {
+ WARN ("Nodes out of sync - resyncing ".++$tries." time(s)");
+ sync_node();
+ sleep 3;
+ get_connection_info($tries);
+ }
+ else {
+ ERROR ("Nodes out of sync! No timeserver configured, aborting.");
+ }
+
+ return;
+ }
+
+ $config{'latency'} = ( $n1_latency + abs( ($n1_latency) * 0.20) );
+ VERBOSE ("RC latency set to: ".$config{'latency'});
+
+ return;
+}
+
+
+# wait for a reply. timeout on closed socket
+# FIXME: timeout set to 5 secs for testing purpose
+sub wait_for_reply {
+ my ($node_number) = @_;
+ my $reply = "";
+ my $timeout;
+ my $buf;
+
+ # FIXME, also use RC value!
+ $timeout = ($seqvars{'timeout'} + 2);
+
+ eval {
+ local $SIG{ALRM} = sub { die "timeout\n" };
+ alarm $timeout;
+
+ #read from pipe
+
+ do {
+ $buf = <CHILD_TO_READ>;
+ } while (!$buf =~ /^$node_number\ /);
+
+ while ($buf ne ".\n") { # read unless last line
+ $reply .= $buf unless $buf eq "\n"; # skip blank lines
+ $buf = <CHILD_TO_READ>;
+ }
+
+ alarm 0;
+ };
+ if ($@) {
+ # exception, should never happen
+ die unless $@ eq "timeout\n";
+ $reply = "timeout";
+ }
+
+ return $reply;
+}
+
+
+# process reply of agents
+sub process_reply {
+ my ($command, @reply) = @_;
+ my $return = 1;
+
+ LOG ("Sent: ".$command);
+ foreach(@reply) {
+ LOG ("Got reply: ". $_);
+ }
+
+ # setup messages
+ if ($command =~ /^setup\ /) {
+ $reply[0] =~ s/^([1,2])\ (.*)\n/$1 /;
+ $reply[1] =~ s/^([1,2])\ (.*)\n/$1 /;
+
+ return @reply;
+ }
+ elsif ($command =~ /^send_log()/) {
+ return @reply;
+ }
+ elsif ($command =~ /^execute\ /) {
+ if ($seqvars{'seq_type'} == 1) { #execute command
+ foreach (@reply) {
+ if (/^([1,2])\ ([0,1])\ /) {
+ VERBOSE ( ($2)?'done':'failed', -1 , $1 );
+ $return &= $2;
+ }
+ else {
+ ERROR ("unknown reply: ".$_);
+ }
+ }
+
+ return $return;
+ }
+ elsif ($seqvars{'seq_type'} == 2) { #expected command
+
+ foreach (@reply) {
+ if (/^([1,2])\ ([0,1])\ ([0-9.]+)\ ([0-9.]+)\n(.*)$/) {
+ VERBOSE ( ($2)?'done ('.$5.')':'failed ('.$5.')', -1 , $1 );
+ $return &= $2;
+ }
+ else {
+ ERROR ("unknown reply: ".$_);
+ }
+ }
+
+ return $return;
+ }
+ elsif ($seqvars{'seq_type'} == 3) { #get command
+
+ # return first reply
+ foreach (@reply) {
+ if (/^([1,2])\ ([0,1])\ ([0-9.]+)\ ([0-9.]+)\n(.*)$/s) {
+ if ($2 == 0) {
+ return 0;
+ }
+ elsif ($2 == 1) {
+ my $output = $5;
+ chomp($output);
+ VERBOSE ($output, -1 , $1 );
+ return $output;
+ }
+ }
+ else {
+ ERROR ("unknown reply: ".$_);
+ }
+ }
+ return 0;
+
+ }
+ }
+
+}
+
+
+# process and show report
+sub show_report {
+ my ($result) = @_;
+
+ if (defined($opt_l)) {
+ eval {
+ open(LOGFILE, ">".$opt_l) or die ($!."\n");
+ };
+ if ($@) {
+ WARN ("Unable to handle logfile: ".$@);
+ }
+
+ my @mnames = ('Jan', 'Feb', 'Mar', 'Apr',
+ 'May', 'Jun', 'Jul', 'Aug',
+ 'Sep', 'Oct', 'Nov', 'Dec');
+
+ my $sec;
+ my $min;
+ my $hour;
+ my $mday;
+ my $mon;
+ my $year;
+ my $wday;
+ my $yday;
+
+ print LOGFILE "--------- TestSuite --------\n";
+ foreach(sort(@logList)) {
+ ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = (localtime($$_[0]));
+ printf LOGFILE "%s %02d %02d:%02d:%02d ", $mnames[$mon], $mday, $hour, $min, \
$sec; + print LOGFILE $$_[1]."\n";
+ }
+ print LOGFILE "--------- TestSuite --------\n";
+
+ if(!$terminated) {
+ get_agent_log();
+ }
+
+ if ($seriallog ne "") {
+ print LOGFILE "\n\n--------- Kernel Messages (serial) ---------\n";
+ print LOGFILE "$seriallog";
+ print LOGFILE "--------- Kernel Messages (serial) ---------\n";
+ }
+
+ close(LOGFILE);
+ }
+
+ print "Test ". (($result)?'ok':'failed') ."\n\n";
+
+ return;
+}
+
+
+# Check if we have permission to write to logfile
+sub test_log {
+ eval {
+ open(LOGFILE, ">".$opt_l) or die ($!."\n");
+ };
+ if ($@) {
+ ERROR ("Unable to handle logfile: ".$@);
+ }
+
+ close LOGFILE;
+}
+
+# Get and write log information of agents if available
+sub get_agent_log {
+ set_default_vars();
+ my @reply = send_command("send_log();");
+
+ foreach(@reply) {
+ if (/^([1,2])\ ([0,1])\ 0\ 0\n(.*)\s$/s) {
+ if ($2 == 0) {
+ WARN ("$3 on ".$config{'node'.$1.'name'});
+ } else {
+ print LOGFILE "\n\n--------- ".$config{'node'.$1.'name'}." ---------\n";
+ print LOGFILE "$3";
+ print LOGFILE "\n\n--------- ".$config{'node'.$1.'name'}." ---------\n";
+ }
+ }
+ }
+
+ return;
+}
+
+
+# process seqcommands
+sub process_seqcommands {
+ # uses seqcommands (array with each command)
+ my $seqcommands_eval = join("\n",@seqcommands);
+ $seqcommands_eval =~ s/on\ $config{node1name}/on\ '1'/g;
+ $seqcommands_eval =~ s/on\ $config{node2name}/on\ '2'/g;
+
+ my $key;
+ my $value;
+
+ while(($key, $value) = each(%commands)) {
+ $seqcommands_eval =~ s/cmd $key/cmd '$value'/g;
+ }
+
+ set_default_vars();
+ eval ($seqcommands_eval);
+ if ($@) {
+ # exceptions
+ LOG ($@);
+ return 0;
+ }
+
+ return 1;
+}
+
+
+# set seq parameters to default values
+sub set_default_vars() {
+ $seqvars{'timeout'} = $config{'timeout'};
+ $seqvars{'on'} = 0;
+ $seqvars{'rc'} = 0;
+ $seqvars{'type'} = '';
+ $seqvars{'state'} = '';
+ $seqvars{'seq_type'} = 0;
+ $seqvars{'FIXME'} = 0;
+}
+
+###############################################################################
+###### help functions
+###############################################################################
+
+# print verbose information
+sub VERBOSE {
+ if (!defined($opt_v) && !defined($opt_l)) {
+ return;
+ }
+
+ my ($msg, $to, $from) = @_;
+ my $tmp = "";
+
+
+ if (defined($from)) {
+ if ($from == 0) {
+ $from = 'both';
+ }
+ else {
+ $from = $config{'node'.$from.'name'};
+ }
+
+ $tmp = $from ." -> ";
+ }
+ elsif (defined($to)) {
+ if ($to == 0) {
+ $to = 'both';
+ }
+ elsif ($to > 0) {
+ $to = $config{'node'.$to.'name'};
+ }
+
+ $tmp = $to ." <- ";
+ }
+
+ $tmp .= $msg;
+ if(defined($opt_v)) {
+ print $tmp. "\n";
+ }
+
+ LOG($tmp);
+}
+
+# write debug
+sub LOG {
+ my ($msg) = @_;
+
+ if (defined($opt_d)) {
+ print Time::HiRes::time. " -> " .$msg. "\n";
+ }
+
+ if (defined($opt_l)) {
+ push (@logList, [Time::HiRes::time, $msg]);
+ }
+ return;
+}
+
+
+# print warn messages
+sub WARN {
+ my ($msg) = @_;
+
+ if (defined($opt_l)) {
+ LOG("Warning: ".$msg);
+ }
+
+ print "Warning: ". $msg. "\n";
+
+ return;
+}
+
+# print error messages - an error message will be printed in every mode
+sub ERROR {
+ my ($msg) = @_;
+
+ print "Error: " .$msg. "\n";
+
+ LOG(" ERROR " .$msg);
+ $terminated = 1;
+ show_report();
+
+ $SIG{HUP} = 'IGNORE';
+ kill HUP => -$$;
+ exit 1;
+}
+
+# remove whitespaces at the beginning and at the end
+sub trim($) {
+ my $string = shift;
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+ return $string;
+}
+
+###############################################################################
+###### testing stuff
+###############################################################################
+
+# do something, execute command, process output
+sub test {
+ print "\nPRINT:\n";
+ print "Node1 Name: $config{'node1name'}\n";
+ print "Node1 IP: $config{'node1addr'}\n";
+ print "Node1 Port: $config{'node1port'}\n";
+ print "Node2 Name: $config{'node2name'}\n";
+ print "Node2 IP: $config{'node2addr'}\n";
+ print "Node2 Port: $config{'node2port'}\n";
+ print "Timeout: $config{'timeout'}\n";
+
+ foreach (@seqcommands) {
+ print ": ".$_."\n";
+ }
+
+ LOG ("Testlog");
+ WARN ("Testwarn");
+
+ ERROR("Testerror");
+ exit;
+}
+
+###############################################################################
+###### main
+###############################################################################
+
+load_conf();
+if (defined($opt_l)) {
+ test_log();
+ #listen_serial();
+}
+get_sockets();
+
+#fork and open pipe to read from child
+my $pid = open(CHILD_TO_READ, "-|");
+
+if ($pid > 0) {
+ # parent - send test data to agents
+
+ $SIG{INT} = \&kill_parent;
+
+ # create listeners for serial devices
+ if (defined($opt_l)) {
+ my $spid1 = open(SERIAL1, "-|");
+ if ($spid1 == 0) {
+ use vars qw (
+ $seriallog;
+ );
+ my $serial;
+ $seriallog = "";
+
+ $SIG{USR1} = sub {
+ print STDOUT $seriallog;
+ exit;
+ };
+
+ eval {
+ open($serial, "</dev/ttyS0") or die ($!."\n");
+ };
+ if ($@) {
+ $seriallog = "Error accessing /dev/ttyS0 : ".$@;
+ while(1) { }; # wait till we die
+ }
+
+ while (<$serial>) {
+ next if (/^\s*$/);
+ $seriallog .= gmtime()." ".$config{'node1name'}." ".$_;
+ }
+
+ while(1) { };
+ exit 0;
+ }
+
+ my $spid2 = open(SERIAL2, "-|");
+ if ($spid2 == 0) {
+ use vars qw (
+ $seriallog;
+ );
+ my $serial;
+ $seriallog = "";
+
+ $SIG{USR1} = sub {
+ print STDOUT $seriallog;
+ exit;
+ };
+
+ eval {
+ open($serial, "</dev/ttyS1") or die ($!."\n");
+ };
+ if ($@) {
+ $seriallog = "Error accessing /dev/ttyS1 : ".$@;
+ while(1) { }; # wait till we die
+ }
+
+
+ while (<$serial>) {
+ next if (/^\s*$/);
+ $seriallog .= gmtime()." ".$config{'node2name'}." ".$_;
+ }
+
+ while(1) { };
+ close($serial);
+ exit 0;
+ }
+ }
+
+ # check system time, process commands, show report
+ if (!defined($opt_i)) {
+ get_connection_info();
+ }
+
+ my $result = process_seqcommands();
+
+ # get serial logs
+ if (defined($opt_l)) {
+ kill USR1 => -$$;
+ while (<SERIAL1>) {
+ $seriallog .= $_;
+ }
+
+ kill USR2 => -$$;
+ while (<SERIAL2>) {
+ $seriallog .= $_;
+ }
+ }
+
+ show_report($result);
+
+ # kill child processes
+ local $SIG{HUP} = 'IGNORE';
+ kill HUP => -$$;
+}
+elsif ($pid == 0) {
+ # child - get data from agent
+
+ $cpid = fork();
+ if ($cpid > 0) {
+ my $node1 = $config{'node1'};
+ my $collect_reply = "";
+ my $reply;
+
+ while (<$node1>) { # wait for client reply
+ $collect_reply .= $_;
+ if($_ eq ".\n") { #last line
+ $reply = $collect_reply;
+ $collect_reply = "";
+
+ #send data to pipe
+ print STDOUT "1 ".$reply."\n";
+ }
+ }
+
+ WARN ("node1 closed connection");
+ kill INT => $pid;
+
+ exit 0;
+ }
+ elsif ($cpid == 0) {
+ my $node2 = $config{'node2'};
+ my $collect_reply = "";
+ my $reply;
+
+ while (<$node2>) { # wait for client reply
+ $collect_reply .= $_;
+ if($_ eq ".\n") { #last line
+ $reply = $collect_reply;
+ $collect_reply = "";
+
+ #send data to pipe
+ print STDOUT "2 ".$reply."\n";
+ }
+ }
+
+ WARN ("node2 closed connection");
+ kill INT => $pid;
+
+ exit 0;
+ }
+ else {
+ # fork failed
+ ERROR ("Fork() failed... can not continue!\n");
+
+ exit 0;
+ }
+
+ exit 0;
+}
+else {
+ # fork failed
+ ERROR ("Fork() failed... can not continue!\n");
+
+ exit 0;
+}
+
+exit 0;
Property changes on: trunk/testing/testsuite/testsuite.pl
___________________________________________________________________
Name: svn:executable
+ *
_______________________________________________
drbd-cvs mailing list
drbd-cvs@lists.linbit.com
http://lists.linbit.com/mailman/listinfo/drbd-cvs
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic