#!/usr/bin/perl # MimerDesk # Web based groupware and eLearning environment # www.mimerdesk.org # # Copyright (C) 2001 Ionstream Ltd. # www.ionstream.fi # # This program is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by the Free # Software Foundation; either version 2 of the License, or (at your option) # any later version. # # This program is distributed with a hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License # for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # $Id: boarddownload.html,v 1.12 2002/07/18 11:44:49 inf Exp $ #"""""""""""""""""""""""""""""""""""""""""# # # # MimerDesk: Resources - Board download # # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # (c) Ionstream Oy 1999 - 2001 # # # # programming by: Teemu Arina # # # #_________________________________________# use strict; # gotta luv da strict use vars qw ($ACTIVEGRP $APPLICATION $USER $IP $LAST_ACT $FORWARDED $GROUPACTIVOR $CRLF $TIME_USED $IDLE $form $ref $sth $attachments $dir $mimetypes); use lib::MimerDesk; sub view_file; sub get_extension; sub download_file; ######################### # Settings # ######################### $APPLICATION = 'Resources - Board download'; ######################### # Initialize # ######################### # # 1. initialize # 2. read parameters # read_config('../config/mimerdesk.cfg'); initialize(); $attachments = $config{'file_dir'}.'/forums'; $mimetypes = $config{'misc'}.'/rf-mime.types'; $form = decode_multipart(); $form->{'ID'} =~ tr/0-9//cd; $form->{'auth'} =~ tr/0-9a-z//cd; ($USER, $IP, $LAST_ACT, $FORWARDED, $TIME_USED, $IDLE, $ACTIVEGRP) = authenticate($form->{'ID'}, $form->{'auth'}, $form->{'changeGroup'}); if ($form->{'quit'}) {redirect("$config{'loc_server'}$config{'bin_dir'}/index.html?ID=$form->{'ID'}&auth=$form->{'auth'}&quit=quit");} if ($form->{'grouptool'} =~ /^\d+$/) { my ($test); lock_tables('READ', 'groupusers'); db_list("SELECT RIGHTS,USER FROM groupusers where USER = '$USER' and GID = '$form->{'grouptool'}'"); while (my $ref = $sth->fetchrow_hashref()) {$GROUPACTIVOR = $ref->{'USER'};} db_end(); unlock_tables(); if ($GROUPACTIVOR) { $dir = '/groups/'.$form->{'grouptool'}; } else { $form->{'grouptool'} = undef; $dir = '/public'; } } else { $form->{'grouptool'} = undef; $dir = '/public'; } ######################### # Main program # ######################### if ($form->{'file'} =~ /^\d+$/ && $form->{'mid'} =~ /^\d+$/) { my ($i); opendir(DIR, "$attachments/$dir/$form->{'mid'}") or write_log("$USER: Error opening dir $attachments/$dir/$form->{'mid'}. $!", 'error'); foreach (sort {uc($a) cmp uc($b)} readdir DIR) { if (/^\./) {next;} $i++; if ($i == $form->{'file'}) { $form->{'view'} ? view_file("$attachments/$dir/$form->{'mid'}/$_") : $form->{'stream'} ? view_file("$attachments/$dir/$form->{'mid'}/$_") : download_file("$attachments/$dir/$form->{'mid'}/$_"); closedir DIR; exit; } } closedir DIR; } ######################### # Get file extension # ######################### sub get_extension { my ($file) = @_; my @temppi; @temppi = split(/\./, $file); return lc $temppi[@temppi-1]; } ######################### # View document # ######################### # # 1. Open mime types file # 2. Search for mime type based on extension # 3. Return file to the viewer sub view_file { my $file = shift; my (@extensions,$binary,$length); my ($mimetype, $extension, $myext); my ($filename) = $file =~ m{([^/\\:]*)$}; $myext = get_extension($filename); open FILE, "<$mimetypes" or write_log("Error opening file $mimetypes", 'error'); lock(*FILE, 1); while () { @extensions = split /\s+/, $_; foreach $extension (@extensions) { if ($myext eq $extension) {$mimetype = $extensions[0];} } } unlock(*FILE); close FILE; $length = -s $file; $binary = 1 if -B $file; if (!$mimetype && $binary) { $mimetype = "application/octet-stream"; } elsif (!$mimetype && !$binary) { $mimetype = "text/plain"; } if ($mimetype eq 'audio/mpeg' && eval 'require MP3::Info') { my $m3u_filename; MP3::Info->import(qw(get_mp3tag get_mp3info)); my $tag = get_mp3tag($file); my $info = get_mp3info($file); $m3u_filename = $filename; $m3u_filename =~ s/\.mp3$/\.m3u/; if ($form->{'stream'}) { print "Content-Type: audio/mpegurl".$CRLF; print "Content-Disposition: attachment; filename=$m3u_filename".$CRLF.$CRLF; print "#EXTM3U".$CRLF; print "#EXTINF:-1,(MimerDesk) $tag->{'ARTIST'}-$tag->{'TITLE'}".$CRLF; my $url = $ENV{'REQUEST_URI'}; $url =~ s/\&stream\=/\&view\=/; print "$config{'loc_server'}$url".$CRLF; exit; } print "Server: MimerDesk".$CRLF; print "icy-notice1:
This stream requires a shoutcast/icecast compatible player.
".$CRLF; print "icy-notice2:MimerDesk MP3 stream
".$CRLF; print "icy-name:(MimerDesk) $tag->{'ARTIST'}-$tag->{'TITLE'}".$CRLF; print "icy-genre:$tag->{'GENRE'}".$CRLF; print "icy-url:$config{'loc_server'}".$CRLF; print "icy-metaint:0".$CRLF; print "icy-pub:0".$CRLF; print "icy-br:$info->{'BITRATE'}".$CRLF; print "x-audiocast-name:(MimerDesk) $tag->{'ARTIST'}-$tag->{'TITLE'}".$CRLF; print "x-audiocast-genre:$tag->{'GENRE'}".$CRLF; print "x-audiocast-pub:0".$CRLF; print "x-audiocast-br:$info->{'BITRATE'}".$CRLF; print "Accept-Ranges: bytes".$CRLF; } print "Content-Type: $mimetype".$CRLF; print "Accept-Ranges: bytes".$CRLF; print "Content-Disposition: attachment; filename=$filename".$CRLF unless $ENV{'HTTP_USER_AGENT'} =~ /MSIE/; print "Content-Transfer-Encoding: binary$CRLF" if $binary; print "Content-Length: $length".$CRLF.$CRLF; open FILE, "<$file" or write_log("Error opening file $file", 'error'); lock(*FILE, 1); binmode(FILE) if $binary; while () {print $_;} unlock(*FILE); close FILE; } ######################### # Send file # ######################### # # 1. print headers # 2. read file and send it sub download_file { my $file = shift; my ($filename) = $file =~ m{([^/\\:]*)$}; my ($length,$binary,$mimetype); $length = -s $file; $binary = 1 if -B $file; $mimetype = "application/octet-stream"; $mimetype = "text/plain"; print "Content-Type: $mimetype$CRLF"; print "Content-Length: $length$CRLF"; print "Accept-Ranges: bytes".$CRLF; print "Content-Transfer-Encoding: binary$CRLF" if $binary; print "Content-Disposition: attachment; filename=$filename$CRLF$CRLF"; open FILE, "<$file" or write_log("Error opening file $file", 'error'); lock(*FILE, 1); binmode(FILE) if $binary; while () {print;} unlock(*FILE); close FILE; }