view release on metacpan or  search on metacpan

lib/PMLTQ/CGI.pm  view on Meta::CPAN

  if ($opts->{'tmp-dir'}) {
    $tmp_dir=$opts->{'tmp-dir'};
  } else {
    $tmp_dir=File::Temp::tempdir()
  }

  $pid_dir = $opts->{'pid-dir'};
  $desc = $conf->{'description'} || Treex::PML::Factory->createStructure();
  if ($pid_dir and -d $pid_dir) {
    $pid_file = File::Spec->catfile($pid_dir, "pmltq_cgi_$$.$id");
    my $fh;
    if (open ($fh, '>:utf8', $pid_file)) {
      if ($conf->{public}) {
        print $fh ($opts->{'port'}."\n");
        for my $k (qw(title abstract moreinfo)) {
          my $v = $desc->{$k} || '';
          $v=~tr{\n}{ };
          print $fh "$v\n";
        }
        print $fh ($conf->{'featured'}."\n");
  print $fh ($conf->{'anonymous_access'}||''."\n");
        close($fh);
      }
    }
  }

  $auth_file = $opts->{'auth-file'};
  update_auth_info() if $auth_file;

  $use_google_translate = $opts->{'google-translate'};
  $use_ms_translate = $opts->{'ms-translate'};

  $ga_tracking_code = $opts->{'ga-tracking-code'};
  $ga_tracking_domain = $opts->{'ga-tracking-domain'};

}

sub configuration {
    $conf || {};
}


# read authorization data from the auth-file

my %auth_data;
my $last_auth_file_mtime;
sub update_auth_info {
  my $mtime = [stat $auth_file]->[9];
  if (!defined($last_auth_file_mtime) or
      $mtime != $last_auth_file_mtime) {
    %auth_data=();
    print STDERR scalar(localtime).": (Re)loading AUTH information\n";
    $last_auth_file_mtime=$mtime;
    if (open my $af, '<', $auth_file) {
      local $_;
      while (<$af>) {
        chomp if defined($_);
        s{^\s*|\s*$|#.*}{}g;
        next unless length;
        my ($user,$passwd,$selection)=split m{\s*:\s+},$_,3;
        next unless length($user) and length($passwd);
        my $data = $auth_data{$user}={};
        if ($selection) {
          my %s; my $bool = $1 if $selection=~s{^\s*([-+])}{};
          @s{ split m{\s*,\s*}, $selection } = ();
          if (defined($bool) and $bool eq '-') {
            $data->{deny}=\%s;
            next if exists $s{ $service_id }
          } else {
            $data->{allow}=\%s;
            next if !exists $s{ $service_id }
          }
        } else {
          # complete access
          $data->{deny}={};
        }
        $data->{passwd}=$passwd;
      }
      close $af;
    } else {
      print STDERR "Failed to read AUTH information!\n";
    }
  }
}


# this method returns (401,"") for unknown user
# and (200,$password) for a known user.
sub auth {
  my ($url,$user)=@_;
  update_auth_info();
  my $data=$auth_data{$user};
  my $passwd = $data && $data->{passwd};
  unless (defined $passwd) {
    print STDERR scalar(localtime).": denied AUTH to $user for $url: code 401.\n";
    return ("401", "");
  }
  print STDERR scalar(localtime).": accepted AUTH from $user for $url\n";
  return ("200",$passwd);
}

# check if the current HTTP user is authorized for a given service
sub user_authorized {
  my ($cgi,$id)=@_;
  return 1 unless $auth_file;
  my $user = _user_name($cgi);
  my $data = $auth_data{$user};
  return 0 unless ref $data;
  if (ref($data->{allow})) {
    return exists($data->{allow}{$id}) ? 1 : 0;
  }
  if (ref $data->{deny}) {
    return exists($data->{deny}{$id}) ? 0 : 1;
  }
  return 1;
}

# auxiliary method used to generate a HTML description of a given list
# of services
sub _print_service_info {
  my ($cgi,$services)=@_;
  my $format = $cgi->param('format');
  my $current;
  my $uri = URI->new($cgi->url(-base=>1));
  update_auth_info();

lib/PMLTQ/CGI.pm  view on Meta::CPAN

    return 0;
}

# faster form of session_ok... just doesn't check session expiration
sub logged_in {
    my ($cgi)=@_;
    my ($session_id,$user)=($cgi->param('s'), $cgi->param('u'));
    if ($session_id and $user and session_id_string_ok($session_id)
            and user_name_string_ok($user) and (-d $pid_dir)) {
        return 1;
    }
    return 0;
}

sub is_anonymous {
    my ($cgi)=@_;
    return !logged_in($cgi) && $conf->{anonymous_access};
}

sub resp_root {
  my ($cgi)=@_;
  if (session_ok($cgi) or $conf->{anonymous_access}) {
    return redirect($cgi,qq{$APP_PREFIX/${URL_BASE}form});
  } else {
    return redirect($cgi,qq{$APP_PREFIX/${URL_BASE}login});
  }
}

sub resp_about {
  my ($cgi)=@_;
  my $ext = $cgi->param('extended')?1:0;
  _print_service_info($cgi) unless $ext;
  _dump_all_info($cgi) if $ext;
  return 200;
}

sub resp_other_services {
    my ($cgi)=@_;
    my @services;

    # read all pid filesa
    update_auth_info();
    if (-d $pid_dir) {
        for my $file (glob(File::Spec->catfile($pid_dir,"pmltq_cgi_*.*"))) {
            open(my $fh, '<', $file) or next;
            my $port = <$fh>;
            next unless defined $port;
            chomp $port;
            next unless $port;
            my $title = <$fh>;
            $title=~s{\s+}{ }g;
            $title=~s{^ | $}{}g;
            my $abstract = <$fh>;
            $abstract=~s{\s+}{ }g;
            $abstract=~s{^ | $}{}g;
            my $moreinfo = <$fh>; chomp $moreinfo;
            my $featured = <$fh>; chomp $featured;
            my $anonymous_access = <$fh>; chomp $anonymous_access;
            if ($port) {
                my (undef, $id) = split m{\.}, $file,2;
                push @services, {
                    id => $id,
                    port => $port,
                    title => $title,
                    abstract => $abstract,
                    moreinfo => $moreinfo,
                    featured => $featured,
                    access => user_authorized($cgi,$id)||$anonymous_access||0,
                    anonymous_access => $anonymous_access||0,
                    service => undef,
                };
            }
        }
    }
    @services = sort {
        $b->{access} <=> $a->{access} or
            ($a->{featured}||10000) <=> ($b->{featured}||10000) or
                ($a->{title}||'') cmp ($b->{title}||'') or
                    $a->{port} <=> $b->{port} } @services;
    _print_service_info($cgi,\@services);
    return 200;
}

sub _user_name {
  my ($cgi)=@_;
  my $user = $cgi->remote_user || $cgi->param('u') || 'unknown';
  $user=~y{/!#'"*~$^&()[]\{\}\.\+\|}{_}; # sanity
  return $user;
}

sub log_query {
  my ($cgi,$query)=@_;
  $query=~s{^\s+|\s+$}{}g;
  my $md5 = md5_hex($query);
  my $user = _user_name($cgi);
  my $log_string = sprintf("query: time='%s' remote_user='%s' auth='%s' remote_host='%s' port='%s' srv_version='%s'\n",
                           scalar(localtime()), $user, $cgi->auth_type||'',
                           $cgi->remote_host, $cgi->server_port, $PMLTQ::SQLEvaluator::VERSION );
  print STDERR $log_string;
  return unless $log_dir and logged_in($cgi);
  if (!(-d $log_dir) and !(mkdir($log_dir))) {
    warn "Failed to create query log dir: $log_dir: $!\n";
    return;
  }
  my $user_log_dir = File::Spec->catdir($log_dir,$user);
  if (!(-d $user_log_dir) and !(mkdir($user_log_dir))) {
    warn "Failed to create query user log dir: $user_log_dir: $!\n";
    return;
  }
  my $log_file = File::Spec->catfile($user_log_dir,$md5.".txt");
  if (!-f $log_file) {
    if (open my $log, '>', $log_file) {
      print STDERR "query_log_file:", $log_file,"\n";
      print $log "# log: ".$log_string;
      print $log $query;
      close $log;
    } else {
      warn "Failed to create query log file: $log_file: $!\n";
    }
  } else {