temp.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

   if (wantarray() ) {
       return mkstemp($template);
   } else {
       return mktemp($template);
   }

}

=item B<tmpfile>

Returns the filehandle of a temporary file.

  $fh = tmpfile();

The file is removed when the filehandle is closed or when the program
exits. No access to the filename is provided.

If the temporary file can not be created undef is returned.
Currently this command will probably not work when the temporary
directory is on an NFS file system.

Will croak() if there is an error.

=cut

sub tmpfile {

  # Simply call tmpnam() in a list context
  my ($fh, $file) = tmpnam();

  # Make sure file is removed when filehandle is closed
  # This will fail on NFS
  unlink0($fh, $file)
    or return undef;

  return $fh;

}

=back

=head1 ADDITIONAL FUNCTIONS

These functions are provided for backwards compatibility
with common tempfile generation C library functions.

They are not exported and must be addressed using the full package
name.

=over 4

=item B<tempnam>

Return the name of a temporary file in the specified directory
using a prefix. The file is guaranteed not to exist at the time
the function was called, but such guarantees are good for one
clock tick only.  Always use the proper form of C<sysopen>
with C<O_CREAT | O_EXCL> if you must open such a filename.

  $filename = File::Temp::tempnam( $dir, $prefix );

Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
(using unix file convention as an example)

Because this function uses mktemp(), it can suffer from race conditions.

Will croak() if there is an error.

=cut

sub tempnam {

  croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;

  my ($dir, $prefix) = @_;

  # Add a string to the prefix
  $prefix .= 'XXXXXXXX';

  # Concatenate the directory to the file
  my $template = File::Spec->catfile($dir, $prefix);

  return mktemp($template);

}

=back

=head1 UTILITY FUNCTIONS

Useful functions for dealing with the filehandle and filename.

=over 4

=item B<unlink0>

Given an open filehandle and the associated filename, make a safe
unlink. This is achieved by first checking that the filename and
filehandle initially point to the same file and that the number of
links to the file is 1 (all fields returned by stat() are compared).
Then the filename is unlinked and the filehandle checked once again to
verify that the number of links on that file is now 0.  This is the
closest you can come to making sure that the filename unlinked was the
same as the file whose descriptor you hold.

  unlink0($fh, $path)
     or die "Error unlinking file $path safely";

Returns false on error but croaks() if there is a security
anomaly. The filehandle is not closed since on some occasions this is
not required.

On some platforms, for example Windows NT, it is not possible to
unlink an open file (the file must be closed first). On those
platforms, the actual unlinking is deferred until the program ends and
good status is returned. A check is still performed to make sure that
the filehandle and filename are pointing to the same thing (but not at
the time the end block is executed since the deferred removal may not
have access to the filehandle).

Additionally, on Windows NT not all the fields returned by stat() can
be compared. For example, the C<dev> and C<rdev> fields seem to be
different.  Also, it seems that the size of the file returned by stat()
does not always agree, with C<stat(FH)> being more accurate than
C<stat(filename)>, presumably because of caching issues even when
using autoflush (this is usually overcome by waiting a while after
writing to the tempfile before attempting to C<unlink0> it).

Finally, on NFS file systems the link count of the file handle does
not always go to zero immediately after unlinking. Currently, this
command is expected to fail on NFS disks.

This function is disabled if the global variable $KEEP_ALL is true
and an unlink on open file is supported. If the unlink is to be deferred
to the END block, the file is still registered for removal.

This function should not be called if you are using the object oriented
interface since the it will interfere with the object destructor deleting
the file.

=cut

sub unlink0 {

  croak 'Usage: unlink0(filehandle, filename)'
    unless scalar(@_) == 2;

  # Read args
  my ($fh, $path) = @_;

  cmpstat($fh, $path) or return 0;

  # attempt remove the file (does not work on some platforms)
  if (_can_unlink_opened_file()) {

    # return early (Without unlink) if we have been instructed to retain files.
    return 1 if $KEEP_ALL;

    # XXX: do *not* call this on a directory; possible race
    #      resulting in recursive removal
    croak "unlink0: $path has become a directory!" if -d $path;
    unlink($path) or return 0;

    # Stat the filehandle
    my @fh = stat $fh;

    print "Link count = $fh[3] \n" if $DEBUG;

    # Make sure that the link count is zero
    # - Cygwin provides deferred unlinking, however,
    #   on Win9x the link count remains 1
    # On NFS the link count may still be 1 but we cant know that
    # we are on NFS
    return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);

  } else {
    _deferred_unlink($fh, $path, 0);
    return 1;
  }

}

=item B<cmpstat>

Compare C<stat> of filehandle with C<stat> of provided filename.  This
can be used to check that the filename and filehandle initially point
to the same file and that the number of links to the file is 1 (all
fields returned by stat() are compared).

  cmpstat($fh, $path)
     or die "Error comparing handle with file";

Returns false if the stat information differs or if the link count is
greater than 1. Calls croak if there is a security anomaly.

On certain platforms, for example Windows, not all the fields returned by stat()
can be compared. For example, the C<dev> and C<rdev> fields seem to be
different in Windows.  Also, it seems that the size of the file
returned by stat() does not always agree, with C<stat(FH)> being more
accurate than C<stat(filename)>, presumably because of caching issues
even when using autoflush (this is usually overcome by waiting a while
after writing to the tempfile before attempting to C<unlink0> it).

Not exported by default.

=cut

sub cmpstat {

  croak 'Usage: cmpstat(filehandle, filename)'
    unless scalar(@_) == 2;

  # Read args
  my ($fh, $path) = @_;

  warn "Comparing stat\n"
    if $DEBUG;

  # Stat the filehandle - which may be closed if someone has manually
  # closed the file. Can not turn off warnings without using $^W
  # unless we upgrade to 5.006 minimum requirement
  my @fh;
  {
    local ($^W) = 0;
    @fh = stat $fh;
  }
  return unless @fh;

  if ($fh[3] > 1 && $^W) {
    carp "unlink0: fstat found too many links; SB=@fh" if $^W;
  }

  # Stat the path
  my @path = stat $path;

  unless (@path) {
    carp "unlink0: $path is gone already" if $^W;
    return;
  }

  # this is no longer a file, but may be a directory, or worse
  unless (-f $path) {
    confess "panic: $path is no longer a file: SB=@fh";
  }

  # Do comparison of each member of the array
  # On WinNT dev and rdev seem to be different
  # depending on whether it is a file or a handle.
  # Cannot simply compare all members of the stat return
  # Select the ones we can use
  my @okstat = (0..$#fh);  # Use all by default
  if ($^O eq 'MSWin32') {
    @okstat = (1,2,3,4,5,7,8,9,10);
  } elsif ($^O eq 'os2') {
    @okstat = (0, 2..$#fh);
  } elsif ($^O eq 'VMS') { # device and file ID are sufficient
    @okstat = (0, 1);
  } elsif ($^O eq 'dos') {
    @okstat = (0,2..7,11..$#fh);
  } elsif ($^O eq 'mpeix') {
    @okstat = (0..4,8..10);
  }

  # Now compare each entry explicitly by number
  for (@okstat) {
    print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
    # Use eq rather than == since rdev, blksize, and blocks (6, 11,
    # and 12) will be '' on platforms that do not support them.  This
    # is fine since we are only comparing integers.
    unless ($fh[$_] eq $path[$_]) {
      warn "Did not match $_ element of stat\n" if $DEBUG;
      return 0;
    }
  }

  return 1;
}

=item B<unlink1>

Similar to C<unlink0> except after file comparison using cmpstat, the
filehandle is closed prior to attempting to unlink the file. This
allows the file to be removed without using an END block, but does
mean that the post-unlink comparison of the filehandle state provided
by C<unlink0> is not available.

  unlink1($fh, $path)
     or die "Error closing and unlinking file";

Usually called from the object destructor when using the OO interface.

Not exported by default.

This function is disabled if the global variable $KEEP_ALL is true.

Can call croak() if there is a security anomaly during the stat()
comparison.

=cut

sub unlink1 {
  croak 'Usage: unlink1(filehandle, filename)'
    unless scalar(@_) == 2;

  # Read args
  my ($fh, $path) = @_;

  cmpstat($fh, $path) or return 0;

  # Close the file
  close( $fh ) or return 0;

  # Make sure the file is writable (for windows)
  _force_writable( $path );

  # return early (without unlink) if we have been instructed to retain files.
  return 1 if $KEEP_ALL;

  # remove the file
  return unlink($path);
}

=item B<cleanup>

Calling this function will cause any temp files or temp directories
that are registered for removal to be removed. This happens automatically
when the process exits but can be triggered manually if the caller is sure
that none of the temp files are required. This method can be registered as
an Apache callback.

On OSes where temp files are automatically removed when the temp file
is closed, calling this function will have no effect other than to remove
temporary directories (which may include temporary files).

  File::Temp::cleanup();

Not exported by default.

=back

=head1 PACKAGE VARIABLES

These functions control the global state of the package.

=over 4

=item B<safe_level>

Controls the lengths to which the module will go to check the safety of the
temporary file or directory before proceeding.
Options are:

=over 8

=item STANDARD

Do the basic security measures to ensure the directory exists and is
writable, that temporary files are opened only if they do not already
exist, and that possible race conditions are avoided.  Finally the
L<unlink0|"unlink0"> function is used to remove files safely.

=item MEDIUM

In addition to the STANDARD security, the output directory is checked
to make sure that it is owned either by root or the user running the
program. If the directory is writable by group or by other, it is then
checked to make sure that the sticky bit is set.

Will not work on platforms that do not support the C<-k> test
for sticky bit.

=item HIGH

In addition to the MEDIUM security checks, also check for the
possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
sysconf() function. If this is a possibility, each directory in the
path is checked in turn for safeness, recursively walking back to the
root directory.

For platforms that do not support the L<POSIX|POSIX>
C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
assumed that ``chown() giveaway'' is possible and the recursive test
is performed.

=back

The level can be changed as follows:

  File::Temp->safe_level( File::Temp::HIGH );

The level constants are not exported by the module.

Currently, you must be running at least perl v5.6.0 in order to
run with MEDIUM or HIGH security. This is simply because the
safety tests use functions from L<Fcntl|Fcntl> that are not
available in older versions of perl. The problem is that the version
number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
they are different versions.

On systems that do not support the HIGH or MEDIUM safety levels
(for example Win NT or OS/2) any attempt to change the level will
be ignored. The decision to ignore rather than raise an exception
allows portable programs to be written with high security in mind
for the systems that can support this without those programs failing
on systems where the extra tests are irrelevant.

If you really need to see whether the change has been accepted
simply examine the return value of C<safe_level>.

  $newlevel = File::Temp->safe_level( File::Temp::HIGH );
  die "Could not change to high security"
      if $newlevel != File::Temp::HIGH;

=cut

{
  # protect from using the variable itself
  my $LEVEL = STANDARD;
  sub safe_level {
    my $self = shift;
    if (@_) {
      my $level = shift;
      if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
	carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
      } else {
	# Dont allow this on perl 5.005 or earlier
	if ($] < 5.006 && $level != STANDARD) {
	  # Cant do MEDIUM or HIGH checks
	  croak "Currently requires perl 5.006 or newer to do the safe checks";
	}
	# Check that we are allowed to change level
	# Silently ignore if we can not.
        $LEVEL = $level if _can_do_level($level);
      }
    }
    return $LEVEL;
  }
}

=item TopSystemUID

This is the highest UID on the current system that refers to a root
UID. This is used to make sure that the temporary directory is
owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
simply by root.

This is required since on many unix systems C</tmp> is not o