PERL : uptime illegal seek why?

[Linark]

I have this problem when using uptime I am getting an illegal seek in the software error variable $!, and I cant seem to find out why.

Here is my coding :-

#!/usr/bin/perl -w

use CGI::Carp qw(fatalsToBrowser);
use CGI;
use diagnostics;

$slt = new CGI;

#+----------------------------------------------------------------------------------------------+#
# Timing module for the script
use Benchmark;
$t0 = new Benchmark;
#+----------------------------------------------------------------------------------------------+#

print $slt->header;

$t1 = new Benchmark;
$td = timediff($t1, $t0);

( $mp1, $mp2, $mp3, $mp4, $mp5, $mp6, $mp7, $mp8, $mp9, $mp10, $mp11, $mp12, $mp13, $mp14, $mp15, $mp16 ) = split(/\ /,timestr($td));

if ($mp2 <= 1 ) {
$mp2a = "Less than 1 second";
}
else {
if ($mp2 == 1 ) {
$mp2a = "$mp2 second";
}
else {
$mp2a = "$mp2 seconds";
}}

if ($^O ne "MSWin32") {

$load = `uptime`;
$load =~ m/average[s]*: ([\d\.]+)/;
$load = $1;

$server_load = "<b>[</b> Server Load : $load <b>]</b>";

}

if ($mp14 eq "cusr") {
$mp14 = "<font color='red'>cusr</font>";
}

print "<p>

<div align='center'>
<font face='verdana' size='2'>
<b>[</b> Script Execution Time : $mp2a <b>] [</b> CPU Time : $mp14 <b>]</b> <b>[</b> Current Unix Time : " . time . "<b> ]</b> $server_load
</font>
</div>

</p>\n";

$error = $!;

if ($error eq "") {
$error = "--";
}
else {
$error = "<font color='red'>$!</font>";
}

print "<font face='verdana' size='2'>Software Error : $error</font>";

[Brett_Tabke]

Does it happen when you do something just simple:

#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
$load = `uptime`;
print "$load\n";

[seindal]

All sorts of actions can change errno ($!), which is a global variable. It is changed automatically by many system calls.

A general rule in all unix programming is to *never* rely on the value of errno ($!) except immediately after a failed system call.

Hence there are at least two serious problems in your code.

First, you have to check $! *immediately after* running the subshell.
So after

$load = `uptime`;

you should have

$error = $!;

Otherwise all sorts of actions taken by the perl interpreter on your behalf can change errno.

Second problem is somewhat out of your hands. $! is changed by each system call, but the backticks you use imply a whole series of system calls, and *errno is not reset* by successful system calls. The rule here is that errno is only valid *immediately after a failed system call*.

An illegal seek error is a very common condition and often not really an error. The output of your command in backticks is read through a pipe, and very often a file descriptor is tested to see if it is a pipe by performing a seek and looking for an illegal seek error, since pipes are not seekable. It is therefore likely that the series of system calls performed by the backticks include a seek on the pipe, causing the ESPIPE value in errno.

I would suggest that you change your code slightly. Do

$load = `uptime 2>/dev/null`;

and $load should be empty if the command failed, but no error message is produced.

I don't think you will get a reliable behaviour of $! together with commands in backticks because $! is only valid immediately after a failed system call.

René.

[Linark]

I get a illegal seek error by just using that plain bit of uptime!

I also forgot to mention, that sometimes the benchmark timing messes up and I get cusr, instead of the time.

Thanks alot for all the advice, and information!

[seindal]

Hi Linark,

here is an edited down list of the syscalls the code makes on my system (Debian linux w/perl 5.6.1).

The code is:

#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
$load = `uptime`;
print "$load\n";

The important systems calls made by the perl interpreter to execute the code is:

read(0, "#!/usr/bin/perl -w\n", 1024) = 19
read(0, "print \"Content-type: text/html\\n"..., 1024) = 37
read(0, "$load = `uptime`;\n", 1024) = 18
read(0, "print \"$load\\n\";\n", 1024) = 17
read(0, "", 1024) = 0
fstat64(1, {st_mode=S_IFCHR¦0620, st_rdev=makedev(136, 0), ...}) = 0
write(1, "Content-type: text/html\n", 24) = 24
write(1, "\n", 1) = 1
pipe([3, 4]) = 0
pipe([5, 6]) = 0
fork() = 951
close(4) = 0
close(6) = 0
--- SIGCHLD (Child exited) ---
read(5, "", 4) = 0
close(5) = 0
fcntl64(3, F_GETFL) = 0 (flags O_RDONLY)
fstat64(3, {st_mode=S_IFIFO¦0600, st_size=0, ...}) = 0
_llseek(3, 0, 0xbffff610, SEEK_CUR) = -1 ESPIPE (Illegal seek)
read(3, " 14:23:26 up 41 min, 6 users, "..., 4096) = 63
read(3, "", 4096) = 0
close(3) = 0
wait4(951, [WIFEXITED(s) && WEXITSTATUS(s) == 0], 0, NULL) = 951
write(1, " 14:23:26 up 41 min, 6 users, "..., 64) = 64
_exit(0) =?

Notice the _llseek line that generates the error. This is a basically a rewind of the file descriptor - return to the beginning of the file - only it fails on a pipe that is not seekable.

Again, my advice is not to use $! after a command in backticks. It is not reliable.

Simply try the command and see if it generates some output. Ignore $!.

René.

[Linark]

OK, Thanks for the feedback I will just ignore the illegal seeks errors from now on.

The script is located at <snip> .

What do you think is breaking my benchmark calculation?

[edited by: jatar_k at 7:05 pm (utc) on Dec. 17, 2002]
[edit reason] sorry, no urls please [/edit]

[amoore]

use strict.

[Linark]

Is that the only way?

I am sorry for posting a url!

[seindal]

use strict;

is just a tool that helps you find various problems in your code. It requires more discipline of the programmer, which usually helps :)

[Linark]

OK, I will give it a go, I may as well try to break my script.

[seindal]

It won't break anything, but you will have to declare your variables.

[Linark]

Whats the best way to do this? as I have never used use strict before . . . :(

[seindal]

You should make a habit of it.

You just add "use strict;" at the top of your file and correct the compilation errors as you see them.

When one writes a perl program, "use strict;" should be the first line written. It really pays off in the end.

René.

[Linark]

Ok! :)

From now on I will use :

use strict;

Thanks for advice, and feedback!

[seindal]

You're welcome.

[Linark]

I have another problem :(

here is my script logic :-

my $action = $gallery->param('act');
my $user_code = $gallery->param('code');

my $requesting_url = $ENV{HTTP_REFERER};
my $query_string = $ENV{QUERY_STRING};

if ($requesting_url eq "") {
$requesting_url = "--";
}
else {
$requesting_url = $ENV{HTTP_REFERER};
}

if ($query_string eq "") {
$query_string = "--";
}
else {
$query_string = $ENV{QUERY_STRING};
}

&read_cookie;

&validate_cookie;

if (($action eq "update_spec") && ($user_code eq "")) {

if ($member_name eq "Guest" or $member_name eq "") { # <!-- Error is on this line! -->

&specification_update_login;

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel";

&validate_spec;

}

}
else {
if (($action eq "update_profile") && ($user_code eq "")) {

if ($member_name eq "Guest" or $member_name eq "") {

&profile_update_login;

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel";

&validate_profile;

}

}
else {

if (($action eq "UserCP") && ($user_code eq "")) {

if ($member_name eq "Guest" or $member_name eq "") {

print "Location: $gallery_links{login}\n\n";

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel";

&header;
&navigation;
&table_header;
&user_cp;
&table_footer;
&footer;
}

}
else {

if (($action eq "UserCP") && ($user_code eq "01")) {

if ($member_name eq "Guest" or $member_name eq "") {

print "Location: $gallery_links{login}\n\n";

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel $gallery_setup{title_separator} View Specification";

&header;
&navigation;
&table_header;
&view_spec;
&table_footer;
&footer;
}

}
else {

if (($action eq "UserCP") && ($user_code eq "02")) {

if ($member_name eq "Guest" or $member_name eq "") {

print "Location: $gallery_links{login}\n\n";

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel $gallery_setup{title_separator} Edit / Update Specification";

&header;
&navigation;
&table_header;
&edit_spec;
&table_footer;
&footer;
}

}
else {

if (($action eq "UserCP") && ($user_code eq "03")) {

if ($member_name eq "Guest" or $member_name eq "") {

print "Location: $gallery_links{login}\n\n";

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel $gallery_setup{title_separator} View Profile";

&header;
&navigation;
&table_header;
&view_profile;
&table_footer;
&footer;
}

}
else {

if (($action eq "UserCP") && ($user_code eq "04")) {

if ($member_name eq "Guest" or $member_name eq "") {

print "Location: $gallery_links{login}\n\n";

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} User Control Panel $gallery_setup{title_separator} View Profile";

&header;
&navigation;
&table_header;
&edit_profile;
&table_footer;
&footer;
}

}
else {

if (($action eq "LogIn") && ($user_code eq "")) {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} Gallery Login";

&header;
&navigation;
&table_header;
&login;
&table_footer;
&footer;
}
else {
if (($action eq "LogIn") && ($user_code eq "01")) {

&validate_login;

}
else {
if (($action eq "LogIn") && ($user_code eq "02")) {

&validate_spec_login;

}
else {
if (($action eq "Register") && ($user_code eq "")) {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} Gallery Register";

&header;
&navigation;
&table_header;
&register;
&table_footer;
&footer;
}
else {
if (($action eq "Register") && ($user_code eq "01")) {

&validate_registration;

}
else {

my $page_title = "$gallery_setup{site_name} $gallery_setup{title_separator} Gallery Index";

&header;
&navigation;
&table_header;
&middle;
&table_footer;
&footer;
}}}}}}}}}}}}

&admin_info;
&development_mode;

#
#+------------------------------------------------------------------------------+#
#

and here are my two other sub routines

#+------------------------------------------------------------------------------+#
#
sub read_cookie {

$member_cookie = $gallery->cookie('vauxweb_gallery');

# then we spilt the cookie details by spilting via the pipe ¦.
( $cookie_user_name, $cookie_password, $model ) = split(/\¦/, $member_cookie);
}
#
#+------------------------------------------------------------------------------+#
#

#
#+------------------------------------------------------------------------------+#
#
sub validate_cookie {

if ($cookie_user_name eq "") {
my $member_name = "Guest";
}
else {
my $member_name = $cookie_user_name;
}

}
#
#+------------------------------------------------------------------------------+#
#

the problem I get is :

Global Symbol "$member_name" requires explicit package name at line 137.

What do I need to do to solve this problem?

[seindal]

I can't figure out the like from you post, but

Global Symbol "$member_name" requires explicit package name at line 137.

means that you are using an undeclared global variable.

From the perldiag(1) man-page:

Global symbol "%s" requires explicit package name
(F) You've said "use strict vars", which indicates that all variables must either be lexically scoped (using "my"), declared beforehand using "our", or explicitly qualified to say which package the global variable is in (using "::").

You are having problems with variable scopes. For example, this sub does nothing sensible:

sub validate_cookie {
if ($cookie_user_name eq "") {
my $member_name = "Guest";
}
else {
my $member_name = $cookie_user_name;
}
}

A my variable only exists in the block where it is declared, so in the above code you are creating a lexically scoped variable, assigning a value after which the variables falls out of scope and disappears.

Your sub does nothing. I suspect you are used to working with global variables and rely on subs with side-effects, and in that case you have to declare all your global variables at the beginning of you file with "our", like

our $member_name;

An then you sub can work with the side effect, as

sub validate_cookie {
if ($cookie_user_name eq "") {
$member_name = "Guest";
}
else {
$member_name = $cookie_user_name;
}
}

Which can be written much more succinctly as

sub validate_cookie {
$member_name = $cookie_user_name ¦¦ 'Guest';
}

for which you hardly need a sub.

If you want to use global variables, declare you globals at the beginning of the file with 'our'.

I get the impression that you have simply sprinkled 'my' declarations everywhere you got an error message, but that will break your program. You need to study perl's idea of scope a bit to use my. That would be a good idea anyway, because programs relying on globals and side-effects are notoriously hard to maintain once they have reached a certain size. You certainly don't want to maintain a 10000 lines application that is coded like that.

René.

[Linark]

I get the feeling, it would be far easier to start this script again, but using use strict;

I am gratefull for all the help, even though I am a bad coded!

[seindal]

... even though I am a bad coded!

Fortunately, that is not a cronic condition.

[Linark]

Well from all the help I have got from this website, it should make me a better coder.

Thanks for the vote of confidence :)

I appericate the help and support :D

[Linark]

Is this acceptable coding?

#!/usr/bin/perl
package gallery;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use strict;
my $gallery = new CGI;
&header;
#
#+------------------------------------------------------------------------------+#
#
sub header {
 print $gallery->header;
 require "my/path/to/Header.html";
}
#
#+------------------------------------------------------------------------------+#
#

[seindal]

Hi,

Add "use warnings;" after "use strict;"

Use function arguments and return values to encapsulate functionality

You use a file global and a sub without arguments:

my $gallery = new CGI;
&header;

This should be

my $gallery = new CGI;
header($gallery);

Then the sub should be

sub header {
my ($gallery) = @_;
print $gallery->header;
}

I do not understand your require line. The content of the file will be evaluated as perl code, but it is a html file!

René.

[Linark]

It is a HTML page but it is wrapped in print" ";

I do this to keep all my HTML coding remote from my scripting!

what does this line mean? my ($gallery) = @_;?

[seindal]

> It is a HTML page but it is wrapped in print" ";

Then it is a perl file.

> I do this to keep all my HTML coding remote from my scripting!

There are many template systems out there, that also allow easy substitution into the templates. Have a look at HTML::Template for example.

> what does this line mean? my ($gallery) = @_;?

@_ is a list of all the arguments to a sub,
so it is a declaration and a statement at the same time.
It is a very common way of giving names to the otherwise unnamed arguments.

The first argument is placed in $gallery, the others are ignored.

René.

[Linark]

I will take a look at that!

Thanks for all your help.

I'll let you know how I get on . . .