[LON-CAPA-cvs] cvs: loncom /interface loncreatecourse.pm lonmanagekeys.pm /lonnet/perl lonnet.pm
www
lon-capa-cvs@mail.lon-capa.org
Tue, 22 Apr 2003 21:00:42 -0000
This is a MIME encoded message
--www1051045242
Content-Type: text/plain
www Tue Apr 22 17:00:42 2003 EDT
Modified files:
/loncom/interface loncreatecourse.pm lonmanagekeys.pm
/loncom/lonnet/perl lonnet.pm
Log:
Continued work on key access to courses.
--www1051045242
Content-Type: text/plain
Content-Disposition: attachment; filename="www-20030422170042.txt"
Index: loncom/interface/loncreatecourse.pm
diff -u loncom/interface/loncreatecourse.pm:1.19 loncom/interface/loncreatecourse.pm:1.20
--- loncom/interface/loncreatecourse.pm:1.19 Mon Mar 24 09:53:46 2003
+++ loncom/interface/loncreatecourse.pm Tue Apr 22 17:00:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Create a course
#
-# $Id: loncreatecourse.pm,v 1.19 2003/03/24 14:53:46 www Exp $
+# $Id: loncreatecourse.pm,v 1.20 2003/04/22 21:00:42 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -293,7 +293,11 @@
$ccuname.' at '.$ccdomain.': '.
&Apache::lonnet::assignrole($ccdomain,$ccuname,$courseid,'cc').'<p>');
}
- $r->print('Roles will be active at next login.</body></html>');
+ if ($ENV{'form.setkeys'}) {
+ $r->print(
+ '<p><a href="/adm/managekeys?cid='.$crsudom.'_'.$crsunum.'">Manage Access Keys</a></p>');
+ }
+ $r->print('<p>Roles will be active at next login.</p></body></html>');
}
# ===================================================================== Handler
Index: loncom/interface/lonmanagekeys.pm
diff -u loncom/interface/lonmanagekeys.pm:1.1 loncom/interface/lonmanagekeys.pm:1.2
--- loncom/interface/lonmanagekeys.pm:1.1 Sat Apr 12 11:57:30 2003
+++ loncom/interface/lonmanagekeys.pm Tue Apr 22 17:00:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to manage course access keys
#
-# $Id: lonmanagekeys.pm,v 1.1 2003/04/12 15:57:30 www Exp $
+# $Id: lonmanagekeys.pm,v 1.2 2003/04/22 21:00:42 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -48,7 +48,7 @@
</head>
$bodytag
<form method="post" enctype="multipart/form-data"
- action="/adm/keymanage" name="keyform">
+ action="/adm/managekeys" name="keyform">
ENDHEAD
}
@@ -62,7 +62,7 @@
#
#
#
- my $cid=$ENV{'request.course.id'};
+ my $cid=$ENV{'form.cid'};
#
# Variables for excel output
my ($excel_workbook, $excel_sheet, $excel_filename,$row);
@@ -111,7 +111,22 @@
} elsif ($mode eq 'excel') {
$excel_workbook->close();
$r->print('<p><a href="'.$excel_filename.'">'.
- 'Your Excel spreadsheet</a> is ready for download.</p>'."\n");
+ 'Your Excel spreadsheet</a> is ready for download.</p>'."\n");
+ }
+}
+
+
+# ----------------------------------------------------------- Toggle Key Access
+
+sub togglekeyaccess {
+ my %cenv=@_;
+ unless ($cenv{'domain'}) { return; }
+ if ($cenv{'keyaccess'} eq 'yes') {
+ &Apache::lonnet::del('environment',['keyaccess'],
+ $cenv{'domain'},$cenv{'num'});
+ } else {
+ &Apache::lonnet::put('environment',{'keyaccess' => 'yes'},
+ $cenv{'domain'},$cenv{'num'});
}
}
@@ -124,32 +139,64 @@
$r->send_http_header;
return OK;
}
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['state']);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['state','cid']);
+ if (($ENV{'form.domain'}) && ($ENV{'form.course'})) {
+ $ENV{'form.cid'}=$ENV{'form.domain'}.'_'.$ENV{'form.course'};
+ }
unless (&Apache::lonnet::allowed('mky',$ENV{'request.role.domain'})) {
$ENV{'user.error.msg'}=
"/adm/managekeys:mky:0:0:Cannot manage access keys";
return HTTP_NOT_ACCEPTABLE;
}
- #
- # Only output the header information if they did not request csv format
- #
- if (exists($ENV{'form.state'}) && ($ENV{'form.state'} eq 'csv')) {
- $r->content_type('text/csv');
- } else {
- # Start page
- $r->content_type('text/html');
- $r->send_http_header;
- $r->print(&header());
- }
+ if ($ENV{'form.cid'}) {
+ #
+ # Only output the header information if they did not request csv format
+ #
+ if (exists($ENV{'form.state'}) && ($ENV{'form.state'} eq 'csv')) {
+ $r->content_type('text/csv');
+ } else {
+ # Start page
+ $r->content_type('text/html');
+ $r->send_http_header;
+ $r->print(&header());
+ }
+ $r->print('<input type="hidden" name="cid" value="'.$ENV{'form.cid'}.
+ '" />');
+ my %cenv=&Apache::lonnet::coursedescription($ENV{'form.cid'});
+ if ($ENV{'form.toggle'}) {
+ &togglekeyaccess(%cenv);
+ %cenv=&Apache::lonnet::coursedescription($ENV{'form.cid'});
+ }
+ if ($cenv{'keyaccess'} eq 'yes') {
+ $r->print('Access to this course is key controlled. <input type="submit" name="toggle" value="Open Access" />')
+ } else {
+ $r->print('Access to this course is open, no access keys. <input type="submit" name="toggle" value="Control Access" />');
+ }
+ $r->print('<hr />');
#
# do stuff here.
#
-
- if (exists($ENV{'form.state'}) && ($ENV{'form.state'} eq 'csv')) {
- $r->print("\n");
+
+ if (exists($ENV{'form.state'}) && ($ENV{'form.state'} eq 'csv')) {
+ $r->print("\n");
+ } else {
+ $r->print('</form></body></html>');
+ }
} else {
- $r->print('</form></body></html>');
+ # Start page no course id
+ $r->content_type('text/html');
+ $r->send_http_header;
+ $r->print(&header().&Apache::loncommon::coursebrowser_javascript());
+ $r->print(
+ 'Course ID: <input input type="text" size="25" name="course" value="" />');
+ $r->print('Domain: '.&Apache::loncommon::select_dom_form(
+ $ENV{'request.role.domain'},'domain'));
+ $r->print(&Apache::loncommon::selectcourse_link(
+ 'keyform','course','domain'));
+ $r->print('<br /><input type="submit" value="Manage Access Keys" />');
+ $r->print('</form></body></html>');
}
return OK;
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.363 loncom/lonnet/perl/lonnet.pm:1.364
--- loncom/lonnet/perl/lonnet.pm:1.363 Fri Apr 18 09:47:55 2003
+++ loncom/lonnet/perl/lonnet.pm Tue Apr 22 17:00:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.363 2003/04/18 13:47:55 www Exp $
+# $Id: lonnet.pm,v 1.364 2003/04/22 21:00:42 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -591,7 +591,11 @@
# --------------------------------------------------- Assign a key to a student
sub assign_access_key {
- my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+ my ($ckey,$cdom,$cnum,$udom,$uname,$logentry)=@_;
$cdom=
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
$cnum=
@@ -599,13 +603,16 @@
$udom=$ENV{'user.name'} unless (defined($udom));
$uname=$ENV{'user.domain'} unless (defined($uname));
my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
- if (($existing{$ckey}=~/^\d+$/) || # has time - new key
- ($existing{$ckey} eq $uname.':'.$udom)) { # this should not happen,
+ if (($existing{$ckey}=~/^\#(.*)$/) || # - new key
+ ($existing{$ckey}=~/^$uname\:$udom\#(.*)$/)) {
+ # assigned to this person
+ # - this should not happen,
# unless something went wrong
# the first time around
# ready to assign
- } elsif (!$existing{$ckey}) {
- if (&put('accesskey',{$ckey=>$uname.':'.$udom},$cdom,$cnum) eq 'ok') {
+ $logentry=$1.'; '.$logentry;
+ if (&put('accesskey',{$ckey=>$uname.':'.$udom.'#'.$logentry},
+ $cdom,$cnum) eq 'ok') {
# key now belongs to user
my $envkey='key.'.$cdom.'_'.$cnum;
if (&put('environment',{$envkey => $ckey}) eq 'ok') {
@@ -618,6 +625,7 @@
} else {
return 'error: Could not assign key, try again later.';
}
+ } elsif (!$existing{$ckey}) {
# the key does not exist
return 'error: The key does not exist';
} else {
@@ -626,10 +634,39 @@
}
}
+# ------------------------------------------ put an additional comment on a key
+
+sub comment_access_key {
+#
+# a valid key looks like uname:udom#comments
+# comments are being appended
+#
+ my ($ckey,$cdom,$cnum,$logentry)=@_;
+ $cdom=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+ $cnum=
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+ my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
+ if ($existing{$ckey}) {
+ $existing{$ckey}.='; '.$logentry;
+# ready to assign
+ $logentry=$1.'; '.$logentry;
+ if (&put('accesskey',{$ckey=>$existing{$ckey}},
+ $cdom,$cnum) eq 'ok') {
+ return 'ok';
+ } else {
+ return 'error: Count not store comment.';
+ }
+ } else {
+# the key does not exist
+ return 'error: The key does not exist';
+ }
+}
+
# ------------------------------------------------------ Generate a set of keys
sub generate_access_keys {
- my ($number,$cdom,$cnum)=@_;
+ my ($number,$cdom,$cnum,$logentry)=@_;
$cdom=
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
$cnum=
@@ -650,7 +687,11 @@
if ($existing{$newkey}) {
$i--;
} else {
- if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') {
+ if (&put('accesskeys',
+ { $newkey => '# generated '.localtime().
+ ' by '.$ENV{'user.name'}.'@'.$ENV{'user.domain'}.
+ '; '.$logentry },
+ $cdom,$cnum) eq 'ok') {
$total++;
}
}
@@ -671,7 +712,7 @@
$udom=$ENV{'user.name'} unless (defined($udom));
$uname=$ENV{'user.domain'} unless (defined($uname));
my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
- return ($existing{$ckey} eq $uname.':'.$udom);
+ return ($existing{$ckey}=~/^$uname\:$udom\#/);
}
# ------------------------------------- Find the section of student in a course
--www1051045242--