######################################################################
#
# Perl module: P3P::HTTPCheck
#
######################################################################
#
# $Id: http.pl,v 1.8 2002/02/06 15:26:17 koike Exp $
# Created by Yuichi Koike (koike@w3.org)
#

use strict;

######################################################################
package P3P::HTTPCheck;
######################################################################

sub new {
    my ($class, %args) = @_;
	my $self = bless {}, $class;
	my @errors;
	$self->{errors} = \@errors;
	return $self;
}

sub targetURI {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{target_uri} = $arg;
	} else {
		return $self->{target_uri};
	}
}

sub prf_uri {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{prf_uri} = $arg;
	} else {
		return $self->{prf_uri};
	}
}

sub content {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{content} = $arg;
	} else {
		return $self->{content};
	}
}

sub content_type {
	my ($self, $arg) = @_;
	if($arg) {
		$self->{content_type} = $arg;
	} else {
		return $self->{content_type};
	}
}

sub check {
	my ($self, $step, $pr, $prf_uri) = @_;
	$self->{step} = $step;
	$self->{pr} = $pr;
	$self->{prf_uri} = $prf_uri;
	my $target_uri = $self->{target_uri};
	my $te_uri = $target_uri;
	$te_uri =~ s/\//%2F/g; $te_uri =~ s/\&/%26/g; $te_uri =~ s/\:/%3A/g;

	# Intiail message
	my $head = " (
<a target='hwin' href='header.pl?mode=header&uri=$te_uri'>HTTP headers</a>
)";
	$pr->pri("<hr>\n");
	$pr->step($step, 0,  " HTTP Protocol Validation", $head);

	# GET the uri
	my $xml = new P3P::XML;
	$xml->setURI($target_uri);
	$xml->access("NO_REDIRECT");

	# Error message
	if(! $xml->{response}->code =~ /^[23]/) {
		$self->addError("err", $xml->{error});
	} else {
		# restore the content
		$self->{content} = $xml->{content};
		$self->{content_type} = $xml->{content_type};
	}

	# Search P3P: header
	my @prfs;	# will contain policyref URI
	my $headstr;	# will contain all P3P: policyref header
	my $zero_prf;
	my $multi_prf;
	my $headcount = 0;

	#policyref check
	foreach my $p3p ($xml->{response}->headers->header("P3P")) {
		$headstr = ($headstr ? $headstr."\n" : "")."P3P:".$p3p;

		my $count = 0;
		while($p3p =~ s/policyref=(?:\"|\')(.*?)(?:\"|\')//i) {
			push(@prfs, $1);
			$count++;
		}
		if($count eq 0) {
			$zero_prf = 1;
		} elsif($count > 1) {
			$multi_prf = 1;
		}
		$headcount++;
	}


	if($zero_prf) {
		$self->addError("msg", "<tt>P3P:</tt> header does not include 
[<tt>policyref=\"URI\"</tt>] directive.");
	}

	if($multi_prf) {
		$self->addError("warn", "Each <tt>P3P:</tt> header can include 
only one [<tt>policyref=\"URI\"</tt>] directive.");
	}

	my $new_prf_uri;
	my $errFlag;
	foreach my $rela_uri (@prfs) {
		my $uri = P3P::Common::absoluteURI($rela_uri, $target_uri);
		if($new_prf_uri && ($uri ne $new_prf_uri)) {
			$errFlag = 1;
		}
		$new_prf_uri = $uri;
	}

############################################################################
#--Shojima extended partA--(BEGINNING)
############################################################################
        #compact policy check
        my @cps;
        my $zero_cp;
        my $one_cp;
        my $multi_cp;

        foreach my $p3p ($xml->{response}->headers->header("P3P")) {
           my $count = 0;
           while($p3p =~ s/CP=(?:\"|\')(.*?)(?:\"|\')//i){
              push(@cps,$1);
              $count++;
           }
           if($count eq 0) {
              $zero_cp = 1;
           }elsif($count > 1) {
              $multi_cp = 1;
           }elsif($count eq 1){
              $one_cp = 1;
           }
       }

##############################################################################
#--Shojima extended partA--(END)
##############################################################################


	if($errFlag) {
		$self->addError("err", "Multiple P3P headers specify different URIs for policy refernece file.");
		$new_prf_uri = "";
	} elsif($headcount > 1) {
		$self->addError("warn", "Multiple P3P headers.");
	}

	# Check consistency with well-known location
	my $notOK;
	if($prf_uri && $new_prf_uri && ($prf_uri ne $new_prf_uri)) {
		$self->addError("err", "HTTP header specifies different URI
than <tt>/w3c/p3p.xml</tt>.");
		$notOK = 1;
	}

	# Header printing
	if($headstr) {
		$self->addError("code", $headstr);
      }


	# Print result
	if($headstr && $new_prf_uri && ! $notOK) {
		$pr->pri("<p class='result'>HTTP headers are 
<font color='blue'>P3P compliant</font>.");
	} elsif($headstr && $zero_prf) {
		$pr->pri("<p class='result'><tt>P3P:</tt> header does not specify 
policy reference file URI</p>\n");
	} elsif($headstr) {
		$pr->pri("<p class='result'>Target URI returns <tt>P3P:</tt> header 
<font color='red'>with errors or warnings</font>.</p>\n");
	} else {
		$pr->pri("<p class='result'>HTTP headers have no <tt>P3P:</tt> header.</p>\n");
	}

	$self->{prf_uri} = $new_prf_uri;
	$pr->printError($self->errors);

###########################################################################
#--Shojima extended partB--(BEGINNING)
###########################################################################
        # print the results of compact policy validation 

        $self->clearError;

        my $has_error = 0;
        my %count = (
            'access' => '0',
            'disputes' => '0',
            'remedies'=> '0',
            'non-identifiable' => '0',
            'purpose' => '0',
            'recipient' => '0',
            'retention' => '0',
            'category' => '0',
            'test' => '0'
        );

        if($one_cp){
           # parsing compact policy contents
           my @CP_TOKEN = split(' ',$cps[0]);
           foreach my $cp_token (@CP_TOKEN){
               my $element_name = $self->CP_reference($cp_token);    
               if ($element_name eq "access"){
                   $count{"access"}++;
               }
               elsif ($element_name eq "disputes"){
                   $count{"disputes"}++;
               }
               elsif ($element_name eq "remedies"){
                   $count{"remedies"}++;
               }
               elsif ($element_name eq "non-identifiable"){
                   $count{"non-identifiable"}++;
               }
               elsif ($element_name eq "purpose"){
                   $count{"purpose"}++;
               }
               elsif ($element_name eq "recipient"){
                   $count{"recipient"}++;
               }
               elsif ($element_name eq "retention"){
                   $count{"retention"}++;
               }
               elsif ($element_name eq "category"){
                   $count{"category"}++;
               }
               elsif ($element_name eq "test"){
                   $count{"test"}++;
               }
               elsif ($element_name eq "error"){
                   $has_error = 1;
               }  
          }

          # compact policy syntax check
          if ($count{"access"} == 0){
              $has_error = 1;
              $self->addError("err","No \"compact-access\" element exists (one  element required).");
          }
          elsif ($count{"access"} > 1){
              $has_error = 1;
              $self->addError("err","Too many \"compact-access\" elements exist (only one element is allowed).");
          }
          if ($count{"disputes"} > 1){
              $has_error = 1;
              $self->addError("err","Too many \"compact-disputes\" elements exist (zero or one element is allowed).");
          }
          if ($count{"non-identifiable"} > 1){
              $has_error = 1;
              $self->addError("err","Too many \"compact-non-identifiable\" elements exist (zero or one element is allowed)."); 
          }
          if ($count{"retention"} == 0){
              $has_error = 1;
              $self->addError("err","No \"compact-retension\" element exists (at least, one element required).");
          }
          if ($count{"compact-test"} > 1){
              $has_error = 1;
              $self->addError("err","Too many \"compact-test\" elements exist (zero or one element is allowed)."); 
          }

       }

        if($one_cp || $multi_cp){
           $pr->step($step,1,"Compact Policy Validation","");
        }
#        if($one_cp){
#               $pr->pri("<tt><b>Compact Policy </b></tt> exists.<br>");
#}
#        elsif($zero_cp){
#               $pr->pri("<tt><b>Compact Policy </b></tt>
#    does not exist.<br>");
#}
        if($multi_cp){
               $self->addError("warn","Multiple <tt><b>Compact Policies </b></tt>exist.<br>");
}
        if($one_cp){
          if($has_error){
                  $pr->pri("Compact Policy has <font color=\"red\">syntax 
errors or warnings.</font><br>");
              }
           elsif(!$has_error){
                  $pr->pri("Compact Policy <font color=\"blue\">syntax OK.</font><br>");
              }
        }

        $pr->printError($self->errors);
###########################################################################
#--Shojima extended partB--(END)
###########################################################################
	
        $self->clearError;
	return 1;
}

sub addError {
	my ($self, $status, $mes) = @_;	my $err = new P3P::Error;
	$err->status($status);
	$err->message($mes);
	push(@{$self->errors}, $err);
}

sub clearError {
	my ($self) = @_;
	my @new_errors;
	$self->{errors} = \@new_errors;
}

sub errors {
	my ($self) = @_;
	return $self->{errors};
}


##############################################################################
#--Shojima extended partC--(BEGINNING)
##############################################################################
sub CP_reference{
        my ($self,$CP_TOKEN) = @_;

	# value of hash is creqFlag 
	my %compact_access = (
	    'NOI' => 'ng',
	    'ALL' => 'ng',
	    'CAO' => 'ng',
	    'IDC' => 'ng',
	    'OTI' => 'ng',
	    'NON' => 'ng'
	    );
	my %compact_purpose = (
	    'CUR' => 'ok',
	    'ADM' => 'ok',
	    'DEV' => 'ok',
	    'TAI' => 'ok',
            'PSA' => 'ok',
	    'PSD' => 'ok',
	    'IVA' => 'ok',
	    'IVD' => 'ok',
	    'CON' => 'ok',
	    'HIS' => 'ok',
            'TEL' => 'ok',
	    'OTP' => 'ok'
	    );
	my %compact_recipient = (
           'OUR' => 'ng',
	   'DEL' => 'ok',
	   'SAM' => 'ok',
	   'UNR' => 'ok',
	   'PUB' => 'ok',
	   'OTR' => 'ok'
	   );
	my %compact_retention = (
	    'NOR' => 'ng',
	    'STP' => 'ng',
	    'LEG' => 'ng',
	    'BUS' => 'ng',
	    'IND' => 'ng'
	    );
        my %compact_category = (
            'PHY' => 'ng',
            'ONL' => 'ng',
            'UNI' => 'ng',
            'PUR' => 'ng',
            'FIN' => 'ng',
            'COM' => 'ng',
            'NAV' => 'ng',
            'INT' => 'ng',
            'DEM' => 'ng',
            'CNT' => 'ng',
            'STA' => 'ng',
            'POL' => 'ng',
            'HEA' => 'ng',
            'PRE' => 'ng',
            'GOV' => 'ng',
            'OTC' => 'ng',
            'LOC' => 'ng'
            );	
        my %compact_non_identifiable = (
            'NID' => 'ng'
            );
        my %compact_disputes = (
            'DSP' =>'ng'
            );
        my %compact_remedies = (
             'COR' =>'ng',
             'MON' =>'ng',
             'LAW' =>'ng'
            );
        my %compact_test = (
             'TST' =>'ng'
            );

	my $creq = "";

	if($CP_TOKEN =~ /[a-z]/){
	    $CP_TOKEN =~ s/([a-z])//;
	    $creq = $1;
	}

	# compact-access part check
	foreach my $access (keys(%compact_access)){		
	    my $flag = $compact_access{$access}; # $flag=('ok'or'ng')
	    if($CP_TOKEN eq $access){
		if($flag eq "ng"){
		    if($creq) {
			$self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted for this element.");
			return "error";
		    }
		    else{
			return "access";
		    }
		}
		elsif($flag eq "ok"){
		    if(($creq) && !($creq =~ /(a|i|o)/)){
			$self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
			return "error";
		    }
		    else{
			return "access";
		    }
		    
		}		    
	    }
	}

        # compact-disputes part check
        foreach my $disputes (keys(%compact_disputes)){
            my $flag = $compact_disputes{$disputes}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $disputes){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "disputes";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
			return "error";
                    }
		    else{
			return "disputes";
		    }

                }
            }
        }

        # compact-remedies part check
        foreach my $remedies (keys(%compact_remedies)){
            my $flag = $compact_remedies{$remedies}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $remedies){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "remedies";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "remedies";
		    }
                }
            }
        }

        # compact-non-identifiable part check
        foreach my $non_identifiable (keys(%compact_non_identifiable)){
            my $flag = $compact_non_identifiable{$non_identifiable}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $non_identifiable){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "non-identifiable";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "non-identifiable";
		    }
                }
            }
        }

        # compact-purpose part check
        foreach my $purpose (keys(%compact_purpose)){
            my $flag = $compact_purpose{$purpose}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $purpose){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "purpose";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "purpose";
		    }
                }
            }
        }

        # compact-recipient part check
        foreach my $recipient (keys(%compact_recipient)){
            my $flag = $compact_recipient{$recipient}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $recipient){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "recipient";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "recipient";
		    }
                }
            }
        }

        # compact-retension part check
        foreach my $retention (keys(%compact_retention)){
            my $flag = $compact_retention{$retention}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $retention){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "retention";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "retention";
		    }
                }
            }
        }

        # compact-category part check
        foreach my $category (keys(%compact_category)){
            my $flag = $compact_category{$category}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $category){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "category";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "category";
		    }
                }
            }
        }

        # compact-test part check
        foreach my $test (keys(%compact_test)){
            my $flag = $compact_test{$test}; # $flag=('ok'or'ng')
            if($CP_TOKEN eq $test){
                if($flag eq "ng"){
                    if($creq) {
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted.");
                        return "error";
                    }
                    else{
                        return "test";
                    }
                }
                elsif($flag eq "ok"){
                    if(($creq) && !($creq =~ /(a|i|o)/)){
                        $self->addError("err","<tt>".$CP_TOKEN.$creq."</tt>:option [".$creq."] is not permitted (only (a|i|o) permitted).<br>");
                        return "error";
                    }
		    else{
			return "test";
		    }
                }
            }
        }

	$self->addError("err","<tt>".$CP_TOKEN.$creq."</tt> is not valid compact policy element.");
	return "error";
}		
##############################################################################
#--Shojima extended partC--(END)
##############################################################################


# module return code
1;

__END__













































