$title

#! /usr/bin/perl -wT -I/var/dcc/cgi-bin # check this file by running it separately, and so keep the leading comment # This contains old version of common functions for DCC whitelist CGI scripts # for old installations that expect it. They should change to the new # module scheme. # Copyright (c) 2012 by Rhyolite Software, LLC # # This agreement is not applicable to any entity which sells anti-spam # solutions to others or provides an anti-spam solution as part of a # security solution sold to other entities, or to a private network # which employs the DCC or uses data provided by operation of the DCC # but does not provide corresponding data to other users. # # Permission to use, copy, modify, and distribute this software without # changes for any purpose with or without fee is hereby granted, provided # that the above copyright notice and this permission notice appear in all # copies and any distributed versions or copies are either unchanged # or not called anything similar to "DCC" or "Distributed Checksum # Clearinghouse". # # Parties not eligible to receive a license under this agreement can # obtain a commercial license to use DCC by contacting Rhyolite Software # at sales@rhyolite.com. # # A commercial license would be for Distributed Checksum and Reputation # Clearinghouse software. That software includes additional features. This # free license for Distributed ChecksumClearinghouse Software does not in any # way grant permision to use Distributed Checksum and Reputation Clearinghouse # software # # THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE, LLC DISCLAIMS ALL # WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES # OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE, LLC # BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES # OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # # Rhyolite Software DCC 1.3.152-1.119 $Revision$ # Generated automatically from common.in by configure. use strict 'subs'; use integer; use 5.004; use Fcntl qw(:DEFAULT :flock); use POSIX qw(strftime); # global variables # $DCCM_USERDIRS, # from dcc_conf # $whiteclnt, # path to the per-user whitelist file # %query, # $thold_cks, # checksums that can have thresholds # $user, # $hostname, # $user_dir, # $edit_url, # $list_log_url, # $list_log_link, # $list_msg_link, # $edit_url, $edit_link, # $passwd_url, $passwd_link, # $logoutID, # $url_ques, $url_suffix, # $sub_white, # 'subsitute' headers from dcc_conf # $form_hidden # state for main form # quiet Perl taint checks with a path that should work everywhere for # the few commands these scripts use. $ENV{PATH}="/var/dcc/libexec:/sbin:/bin:/usr/sbin:/usr/bin"; # check_user() must be called before html_head() return check_user(); sub debug_time { my($label) = @_; my($str); return if (!$query{debug}); my(@ts, $ts); require 'sys/syscall.ph'; $ts = pack("LL", ()); syscall(&SYS_gettimeofday, $ts, 0); @ts = unpack("LL", $ts); chomp($label); $str = sprintf "%30s", $label; $str .= strftime(" %X", localtime($ts[0])); $str .= sprintf ".%03d", $ts[1]/1000; $str .= sprintf " %5.3f", $_ foreach times; $str .= "\n"; print STDERR $str; } sub debug_printf { my($label, $str) = @_; return if (!$query{debug}); $str =~ s/\n/\\n/g; print STDERR "$label='$str'\n"; } # emit HTTP/HTML header sub html_head { my($title, # title of the web page $refresh_url) = @_; # next step in re-login sequence if not null my($header, $style); print < $title EOF print "\n" if ($refresh_url); # Use header if supplied # it is mostly text for the start of the , # but it can also contain ... $header = "\n"; if (open(HEADER, "$user_dir/header") || open(HEADER, "/var/dcc/cgi-bin/header")) { my $line; $header .= $line while ($line =

); close(HEADER); } # Use our style if the supplied header has none $style = ""; $style .= "$1\n" if ($header =~ s/(\h*]*rel=['"]?stylesheet[^>]*>)//si); $style .= "$1\n" if ($header =~ s/(\h*]*>.*<\/STYLE>)//si); $style = < EOF print <

$title

$header EOF } sub html_footer { if (open(FOOTER, "$user_dir/footer") || open(FOOTER, "/var/dcc/cgi-bin/footer")) { my $line; print $line while ($line =