latexml 0.8.2-1 / usr / bin / latexmlc

#!/usr/bin/perl -w
# /=====================================================================\ #
# |  latexmlc                                                           | #
# | client/server conversion program                                    | #
# |=====================================================================| #
# | Part of LaTeXML:                                                    | #
# |  Public domain software, produced as part of work done by the       | #
# |  United States Government & not subject to copyright in the US.     | #
# |---------------------------------------------------------------------| #
# | Bruce Miller <bruce.miller@nist.gov>                        #_#     | #
# | http://dlmf.nist.gov/LaTeXML/                              (o o)    | #
# \=========================================================ooo==U==ooo=/ #
use strict;
use warnings;

use Cwd qw(cwd abs_path);
use IO::Socket;

my $RealBin_safe;
use FindBin;
use File::Spec::Functions;
use File::Which;

BEGIN {
  if ($FindBin::RealBin =~ /^([^\0]+)\z/) {    # Valid Unix path TODO: Windows, revisit regexp
    $RealBin_safe = $1; }
  die 'Fatal:I/O:tainted RealBin was tainted! Failing...'
    unless ($RealBin_safe && (-e catfile($RealBin_safe, 'latexmlc')));
}
# TODO: We probably want file cat for things like /../lib instead of spelling out a Unix path
use lib catdir($RealBin_safe, "..", "lib");

#TODO: Do we ever care about ENV PATH that much? Do we miss on some feature like that?
#$ENV{PATH} = "$RealBin_safe:/usr/bin:/usr/local/bin:";
use LaTeXML;
use LaTeXML::Common::Config;
use URI::Escape;
use HTTP::Response;
use HTTP::Request;
use JSON::XS qw(decode_json);

binmode(STDERR, ":encoding(UTF-8)");

# Determine if a socket server is installed locally and obtain its pathname:
my $latexmls;
$latexmls = catfile($RealBin_safe, 'latexmls') if (-e catfile($RealBin_safe, 'latexmls'));
$latexmls = which('latexmls') unless defined $latexmls;

# Some defaults:
my $opts = LaTeXML::Common::Config->new(input_limit => 100);

# Parse and load command-line options
$opts->read(\@ARGV);
my $keyvals = $opts->scan_to_keyvals(\@ARGV);

# Client-side options:
my ($port, $address, $expire, $local) = map { $opts->get($_) } qw(port address expire);
$address = '127.0.0.1' if !$address || ($address eq 'localhost');
$address =~ s/^(\w+)\:\/\///;    # strip away any protocol
my $route = '/';
if ($address =~ s/\/(.+)$//) {    # strip away route
  $route = '/' . $1;
}
# Local if peerhost is localhost:
$local = ($expire && ($expire == -1)) || ($address eq '127.0.0.1');
$expire = -1 unless ((defined $expire) && $latexmls);
$port = ($local ? 3334 : 80) unless $port;    #Fall back if all fails...
#***************************************************************************
#Add some base, so that relative paths work
my $cdir = abs_path(cwd());
$cdir =~ s/ /\\ /g;
if (!$opts->get('base')) {
  $opts->set('base', $cdir);
  push @$keyvals, ['base', $cdir];
}
# Record if destination exists, for summary
my $deststat;
$deststat = (stat($opts->get('destination')))[9] if $opts->get('destination');
$deststat = 0 unless defined $deststat;

push @$keyvals, ['path', $cdir];    #add current path, to ensure never empty
push @{ $opts->get('paths') }, $cdir;

# Get the full source of interest
my $source = $opts->get('source');
$opts->delete('source');
if (!$source) { print STDERR "Input was empty.\n"; exit 1; }
if ($source eq '-') {
  { local $/ = undef;
    $source = "literal:" . <STDIN>;
    # Set the source in the keyvals to be sent over the wire:
    @$keyvals = grep { $_->[0] !~ /source|tex/ } @$keyvals;
    push @$keyvals, $source;
  } }
#***************************************************************************
# Prepare output variables:
my ($result, $status, $log);

# TODO: Talk to the web service via HTTP
#Setup client and communicate
my $sock = $latexmls && IO::Socket::INET->new(
  PeerAddr => $address,
  PeerPort => $port,
  Proto    => 'tcp',
);    #Attempt connecting to a service
if ((!$sock) && $local && ($expire == -1)) {
  # Don't boot a server, single job requested:
  require LaTeXML;
  $opts->set('local', 1);
  $opts->push('debug', 'LaTeXML') unless $opts->get('log'); # If we don't request log, print to STDERR
  my $converter = LaTeXML->get_converter($opts);
  $converter->prepare_session($opts);
  my $response = $converter->convert($source);
  ($result, $status, $log) = map { $$response{$_} } qw(result status log) if defined $response;
} else {
  my $message = q{};
  foreach my $entry (@$keyvals) {
    my ($key, $value) = ($$entry[0], $$entry[1]);
    $message .= uri_escape($key) . ($value ? '=' . uri_escape($value) : '') . '&';
  }
  chop $message;
  #Startup daemon and feed in args, if needed
  system($latexmls, "--port=$port",
    "--expire=$expire", "--autoflush=" . $opts->get('input_limit')) if !$sock && $local;
  my $http_response = ($local
    ? process_local($address, $port, $route, $message, $sock)
    : process_remote($address, $port, $route, $message, $sock));
  if ($http_response->is_success) {
    my $response = decode_json($http_response->content);
    ($result, $status, $log) = map { $$response{$_} } qw(result status log) if defined $response;
  } else {
    print STDERR "Fatal:HTTP:" . $http_response->code() . " " . $http_response->message() . "\n"; exit 1;
  }
}

#***************************************************************************
### Common treatment of output:

# Special features for latexmls:
my $whatsout = $opts->get('whatsout');
my $is_archive = $whatsout && ($whatsout =~ /^archive/);
if ($log) {
  if ($opts->get('log')) {
    if (!$is_archive) { # archives only have the archive file
      my $clog = $opts->get('log');
      my $log_handle;
      if (!open($log_handle, ">", $clog)) {
        print STDERR "Fatal:I/O:forbidden Couldn't open log file $clog : $!\n";
        exit 1;
      }
      print $log_handle $log;
      close $log_handle;
    }
  } else { print STDERR $log, "\n"; }    #STDERR log otherwise
}

if ($result) {
  if ($opts->get('destination')) {
    my $output_handle;
    if (!open($output_handle, ">", $opts->get('destination'))) {
      print STDERR "Fatal:I/O:forbidden Couldn't open output file " . $opts->get('destination') . ": $!";
      exit 1; }
    if (!$is_archive) { # If we're not outputing binary data, encode to UTF-8
      binmode($output_handle, ":encoding(UTF-8)"); }
    print $output_handle $result;
    close $output_handle;
  } else {
    if (!$is_archive) { # If we're not outputing binary data, encode to UTF-8
      binmode(STDOUT, ":encoding(UTF-8)"); }
    print STDOUT $result, "\n"; }    #Output to STDOUT
}

# Print summary, if requested, to STDERR
if ($opts->get('destination')) {
  print STDERR $status;
  print STDERR summary($opts->get('destination'), $deststat);
}

# == Helpers ==
sub summary {
  my ($destination, $prior_stat) = @_;
  my $new_stat = (stat($destination))[9] || 0;
  return ($new_stat && ($prior_stat != $new_stat)) ? "\nWrote $destination\n" :
    "\nError! Did not write file $destination\n";
}

sub process_local {
  my ($req_address, $req_port, $req_route, $req_message, $req_sock) = @_;
  #daemon is running, reconnect and feed in request
  $req_sock = IO::Socket::INET->new(
    PeerAddr => $req_address,
    PeerPort => $req_port,
    Proto    => 'tcp',
  ) unless $req_sock;
  if (!$req_sock) {
    print STDERR "Fatal:perl:socket-create Could not create socket: $!\n";
    exit 1; }
  my $req_message_length = length($req_message);
  $req_route = "$req_address:$req_port" unless $req_route;
  my $payload = <<"PAYLOADEND";
POST $req_route HTTP/1.0
Host: $req_address:$req_port
User-Agent: latexmlc
Content-Type: application/x-www-form-urlencoded
Content-Length: $req_message_length

$req_message
PAYLOADEND
  $req_sock->send($payload);
  my $response_string = q{};
  { local $/ = undef;
    $response_string = <$req_sock>; }
  close($req_sock);
  return ($response_string
    ? HTTP::Response->parse($response_string)
    : HTTP::Response->new(500, 'Internal Server Error')); }

sub process_remote {
  my ($req_address, $req_port, $req_route, $req_message, $req_sock) = @_;
  $req_sock->close if $req_sock;    # No need of the socket here, using LWP instead
  my $payload = HTTP::Request->new(POST => "http://$req_address:$req_port$req_route");
  $payload->header('User-Agent',   'latexmlc');
  $payload->header('Content-Type', 'application/x-www-form-urlencoded');
  $payload->content($req_message);
  require LWP::UserAgent;
  my $ua = LWP::UserAgent->new;
  $ua->timeout(10);
  return $ua->request($payload); }

#**********************************************************************
__END__

=head1 NAME

C<latexmlc> - A omni-executable for LaTeXML, capable of
  stand-alone socket-server and (soon) web service conversion.

=head1 SYNOPSYS

See the OPTIONS section in L<LaTeXML::Common::Config> for usage information.
  Also consult latexmlc --help

=head1 DESCRIPTION

L<latexmlc> provides a client which automatically sets up a LaTeXML local server
  if necessary (via L<latexmls>).

  If such server already exists, the client proceeds to communicate normally.

  A stand-alone conversion (the default) can also be requested via --timeout=-1

=head1 SEE ALSO

L<latexmls>, L<ltxmojo>, L<LaTeXML::Common::Config>

=cut