source: debian/lib/gutenbach @ b30ec0c

debianmacno-cupsnodebathenaweb
Last change on this file since b30ec0c was e20354c, checked in by Jessica B. Hamrick <jhamrick@…>, 14 years ago

Fix perl bugs in the filter, change 'daemon' to 'lp'

  • Property mode set to 100755
File size: 10.0 KB
Line 
1#!/usr/bin/perl
2# Play the data on STDIN as an audio file
3#
4# $Id: gutenbach-filter,v 1.26 2009/02/20 00:27:17 geofft Exp root $
5# $Source: /usr/local/bin/RCS/gutenbach-filter,v $
6#
7# TODO
8# ----
9# Make this structured code. It's a mess.
10# Repeat what we just played for EXT files too
11# Support HTTP Auth on ogg streams
12# License, cleanup and package
13#
14# Jered Floyd <jered@mit.edu> takes very little credit for this code
15# apparently neither does Quentin Smith <quentin@mit.edu>
16
17use strict;
18use warnings;
19use Image::ExifTool qw(ImageInfo);
20use File::Spec::Functions;
21use File::Temp qw{tempfile tempdir};
22use File::Basename qw(basename);
23use LWP::UserAgent;
24use Data::Dumper;
25use IPC::Open2;
26use English;
27
28use vars qw/$zephyr_class $host $queue $mixer $channel/;
29
30require "/usr/lib/gutenbach/config/gutenbach-filter-config.pl" or die "Unable to load configuration";
31
32my $ua = new LWP::UserAgent;
33
34# Replace STDERR with a log file in /tmp.
35open(CUPS, ">&STDERR") or die "Unable to copy CUPS filehandle";
36close(STDERR);
37open(STDERR, ">>", "/tmp/gutenbach.log") or warn "Couldn't open log: $!";
38
39# Set the TERM environment (for the benefit of mplayer?)
40# I don't know why we do this --quentin
41$ENV{"TERM"}="vt100";
42
43print STDERR "STDERR FROM SPOOL FILTER\n";
44
45# CUPS provides us with these arguments:
46#
47# argv[1]
48# The job ID
49# argv[2]
50# The user printing the job
51# argv[3]
52# The job name/title
53# argv[4]
54# The number of copies to print
55# argv[5]
56# The options that were provided when the job was submitted
57# argv[6]
58# The file to print (first program only)
59#
60# The scheduler runs one or more of these programs to print any given
61# job. The first filter reads from the print file and writes to the
62# standard output, while the remaining filters read from the standard
63# input and write to the standard output. The backend is the last
64# filter in the chain and writes to the device.
65
66printf(STDERR "Got \@ARGV: %s\n", Dumper(\@ARGV));
67
68my %arguments = (
69                 "job-id" => $ARGV[0],
70                 user => $ARGV[1],
71                 "job-title" => $ARGV[2],
72                 copies => $ARGV[3],
73                 options => {split(/[= ]/, $ARGV[4])},
74                 file => $ARGV[5],
75                );
76
77# If we weren't given a filename, we need to read from stdin. Since
78# mplayer really wants a file, let's write out to a temporary file
79# first.
80if (!$arguments{"file"}) {
81  my ($fh, $file) = tempfile("gutenbachXXXXX", UNLINK => 1); # Ask File::Temp for a safe temporary file
82  my $buf;
83  while (read(STDIN, $buf, 1024*1024)) { # Read 1M at a time and put it in the temporary file
84    print $fh $buf;
85  }
86  close($fh);
87  $arguments{"file"} = $file;
88}
89
90printf(STDERR "Got \%arguments: %s\n", Dumper(\%arguments));
91
92# Open up a zwrite command to announce the current track.
93my @zwrite_command = (qw(/usr/bin/zwrite -d -n -c), $zephyr_class, "-i", $queue.'@'.$host, "-s", "Gutenbach Music Spooler");
94
95print STDERR "Invoking @zwrite_command\n";
96open(ZEPHYR, "|-", @zwrite_command) or die "Couldn't launch zwrite: $!";
97
98print(ZEPHYR $arguments{"user"},"\@",$arguments{"options"}{"job-originating-host-name"}," is playing:\n");
99my $status = "User: ".$arguments{"user"}."\@".$arguments{"options"}{"job-originating-host-name"};
100
101# SIGHUP handler, in case we were aborted
102sub clear_status {
103  my @zwrite_command = (qw(/usr/bin/zwrite -d -n -c), $zephyr_class, "-i", $queue.'@'.$host, "-s", "Gutenbach Music Spooler");
104  open(ZEPH, "|-", @zwrite_command);
105  print(ZEPH "Playback aborted.\n");
106  close(ZEPH);
107  die;
108}
109$SIG{HUP} = \&clear_status;
110
111# Read the metadata information from the file.
112my ($filepath) = $arguments{"file"};
113my ($fileinfo) = ImageInfo($filepath);
114my ($magic) = $fileinfo->{FileType};
115my ($tempdir);
116my ($newpath);
117
118if ($magic) {
119  # $magic means that Image::ExifTool was able to identify the type of file
120  printf(ZEPHYR "%s file %s\n", $magic, $arguments{"job-title"});
121  $status .= sprintf(" Filetype: %s.", $magic);
122  $status .= sprintf(" Filename: %s.", $arguments{"job-title"});
123
124  if (exists $fileinfo->{'Title'}) {
125    printf(ZEPHYR "\@b{%s}\n", $fileinfo->{'Title'}) if exists $fileinfo->{'Title'};
126    $status .= sprintf(" Title: %s.", $fileinfo->{'Title'});
127  }
128  foreach my $key (qw/Artist Album AlbumArtist/) {
129    if (exists $fileinfo->{$key}) {
130      printf(ZEPHYR "%s\n", $fileinfo->{$key}) if exists $fileinfo->{$key};
131      $status .= sprintf(" %s: %s\n", $key, $fileinfo->{$key});
132    }
133  }
134
135  $tempdir = tempdir();
136  #awful hack -- geofft
137  #== -- quentin
138  # This code appears to create a new temporary directory and symlink
139  # the job file into the temporary directory under the original
140  # filename. I think this is because mplayer sometimes uses the file
141  # extension to identify a filetype.
142  $newpath = $tempdir . '/' . basename($arguments{"job-title"});
143  symlink($filepath, $newpath);
144  $filepath = $newpath;
145}
146elsif ($arguments{copies} == 42) {
147  # This is a flag that is set by jobs queued by split_playlist(); it tells us to not try to split the playlist again.
148  # Call resolve_external_reference to apply some heuristics to determine the filetype.
149  $filepath = resolve_external_reference($filepath, \%arguments);
150  if ($filepath =~ m|http://www\.youtube\.com/watch\?v=|) {
151    # YouTube URLs are resolved by the youtube-dl command.
152    # Launch youtube-dl
153    open(YTDL, "-|", "youtube-dl", "-g", $filepath) or die "Unable to invoke youtube-dl";
154    # Read the title (currently not doing so because youtube-dl doesn't know how to get the title.
155    my $title = ""; # <YTDL>
156    # Print the title to zephyr and the status string.
157    print ZEPHYR "YouTube video $filepath\n$title";
158    $status .= " YouTube video $filepath. $title.";
159    # youtube-dl prints the URL of the flash video, which we pass to mplayer as a filename.
160    $filepath = <YTDL>;
161    chomp $filepath;
162  } else { # Doesn't appear to be a YouTube URL.
163    print STDERR "Resolved external reference to $filepath\n";
164    printf(ZEPHYR "%s\n", $filepath);
165    $status .= sprintf(" External: %s\n", $filepath);
166  }
167}
168elsif (-T $filepath) { # If the file appears to be a text file, treat it as a playlist.
169  split_playlist($filepath, \%arguments);
170  close(ZEPHYR);
171  # See http://www.cups.org/documentation.php/api-filter.html#MESSAGES
172  print CUPS "NOTICE: $status\n";
173  exit 0;
174}
175
176close(ZEPHYR);
177print CUPS "NOTICE: $status\n";
178play_mplayer_audio($filepath, \%arguments);
179
180# Remove the symlink we made earlier for the filetype.
181if ($magic) {
182  unlink($newpath);
183  rmdir($tempdir);
184}
185
186# Play an external stream reference
187sub resolve_external_reference {
188  # Retrieve those command line opts.
189  my ($filepath, $arguments) = @_;
190
191  my ($format, $uri, $userpass);
192
193  open(FILE, "<", $filepath) or die "Couldn't open spool file";
194  if (<FILE> =~ /^(\S+)/) {
195    # Take the leading non-whitespace as a URL
196    $uri=$1;
197
198    if ($uri =~ m|http://www\.youtube\.com/watch\?v=|) {
199      return $uri;
200    }
201
202    # Fetch the URL with a HEAD request to get the content type
203    my $response = $ua->head($uri);
204
205    my $contenttype=($response->content_type() or "unknown");
206
207    if ($contenttype eq "audio/mpeg") { $format="MP3" }
208    elsif ($contenttype eq "application/x-ogg") { $format="OGG" }
209    elsif ($contenttype eq "application/ogg") { $format="OGG" }
210    elsif ($contenttype eq "audio/x-scpls") { $format="SHOUTCAST" }
211    else {
212      print ZEPHYR
213        "Unknown Content-Type $contenttype for URI $uri\n";
214    }
215  } else { # Unable to match the URL regex
216    print ZEPHYR "Couldn't read URI for external reference\n";
217    # Return the existing path, in the hopes that mplayer knows what to do with it.
218    return $filepath;
219  }
220
221  if ($format eq "SHOUTCAST") {
222    print ZEPHYR "Shoutcast playlist...\n";
223    return get_shoutcast($uri);
224  } elsif ($format eq "MP3") {
225  } elsif ($format eq "OGG") {
226  } else {
227    print ZEPHYR "Unrecognized stream format: $format\n";
228  }
229  return $uri;
230}
231
232sub split_playlist {
233  my ($file, $arguments) = @_;
234
235  my $i = 0;
236
237  open(FILE, "<", $filepath) or die "Couldn't open spool file";
238  while (<FILE>) {
239    chomp;
240    if (/^([^#]\S+)/) {
241      printf (STDERR "Found playlist line: %s\n", $_);
242      open(LPR, "|-", 'lpr', '-P'.$queue.'@localhost', '-#', '42', '-J', $arguments->{"job-title"}, '-o', 'job-priority=100');
243      print LPR $1;
244      close(LPR);
245      $i++;
246    }
247  }
248  printf(ZEPHYR "Playlist containing %d valid entries, split into separate jobs.\n", $i);
249}
250
251# Process a Shoutcast playlist
252# get_shoutcast(URI)
253sub get_shoutcast {
254  my $uri = shift(@_);
255
256  my $response = $ua->get($uri);
257  my (@titles, @uris);
258
259  foreach (split("\n", $response->content())) {
260      if (/^File\d+=(\S+)/) {
261          push(@uris, $1);
262      }
263      if (/^Title\d+=(.+)$/) {
264          push(@titles, $1);
265      }
266  }
267
268  # choose a random server
269  my $server = int(rand scalar(@uris));
270  # print the name of the stream if available
271  print ZEPHYR "$titles[$server]\n";
272  return $uris[$server];
273}
274
275sub play_mplayer_audio {
276  my ($filepath, $opts) = @_;
277
278
279  # Open up a zwrite command to show the mplayer output
280  my @zwrite_command = (qw(/usr/bin/zwrite -d -n -c), $zephyr_class, "-i", $queue.'@'.$host, "-s", "Gutenbach Music Spooler");
281
282  print STDERR "Invoking @zwrite_command\n";
283  open(ZEPHYR, "|-", @zwrite_command) or die "Couldn't launch zwrite: $!";
284
285  # fork for mplayer
286  my $pid = open(MP3STATUS, "-|");
287  unless (defined $pid) {
288    print ZEPHYR "Couldn't fork: $!\n";
289    close(ZEPHYR);
290    return;
291  }
292
293  if ($pid) { #parent
294    # Check if there were any errors
295    if ($_ = <MP3STATUS>) {
296      print ZEPHYR "Playback completed with the following errors:\n";
297      print ZEPHYR $_;
298      while (<MP3STATUS>) {
299        print ZEPHYR $_;
300      }
301    } else {
302      print ZEPHYR "Playback completed successfully.\n";
303    }
304    close(MP3STATUS) || print ZEPHYR "mplayer exited $?\n";
305
306    close(ZEPHYR);
307  }
308  else { # child
309    # redirect STDERR to STDOUT
310    open STDERR, '>&STDOUT';
311    # make sure that mplayer doesn't try to intepret the file as keyboard input
312    close(STDIN);
313    open(STDIN, "/dev/null");
314
315    my @args = (qw|/usr/bin/mplayer -vo fbdev2 -zoom -x 1024 -y 768 -framedrop -nolirc -ao alsa -cache 512 -really-quiet |, $filepath);
316    #print STDERR "About to exec: ", Dumper([@args]);
317    exec(@args) ||
318      die "Couldn't exec";
319  }
320}
Note: See TracBrowser for help on using the repository browser.